perm filename SMTPSR.FAI[S,NET]20 blob
sn#817371 filedate 1986-05-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00043 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00010 00002 history FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ROBUF ICPBLK ICPSTS ICPSKT HOSTNO CONECB CNIBTS OURSTR HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD maxpth REVPTH COLONS MFRBUF MSJBUF SNDNAM XRFBUF XRFBZZ XRFBBP XRRBBP XXBUF XXBZZ XXBBP NBUFS DSKIBF DSKOBF MFDIBF OLDIBF RLYOBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC RLY MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS WAITST WATSIT
C00037 00003 DEFINITIONS OF A "GLOBAL" NATURE
C00040 00004 ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO
C00044 00005 IDCON IDCONZ IDCONI IDCNFI IDCNFO IDCNFX IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCONS IDCONB IDCONP IDCOND IDCONF IDSOCS IDSOCK IDSOC0 IDSOC1 IDSOC2
C00050 00006 ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
C00062 00007 START %SITE% REGO
C00069 00008 LOOP SCHEK STATUS
C00071 00009 SAVACX SAVACS GETACS
C00073 00010 CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL
C00076 00011 CIROUT COMDIS BADCOM
C00077 00012 APPE STOR WAITIL GETSET GETSE1 GETSEL C2 GETSEA MLFL STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1
C00090 00013 RNFR DELE GCRNTO RENFIL RNMOK RELDMP RNTO BADTO BDTONM BADDRN ALLO
C00093 00014 HELO HELOLP NOOP NOFROM RCPT RCPTML RELDUN RCPTCL RCPTX SYNERR UNKHST BADHMS BADHM2 WHOIAM NORLAY XSEN XSEM XMAS MAIL MAILCM MAILER GETFRM GETFRL GETFRS GETFRQ GETFNQ GETFRE GETFRX OK250 NODEST DATA NMAIL MAILIN NODOT EOMAIL MAIL91 SETMFL SETMFR RMDLK RMDAOS RMDFIL WRHDR WHDFRB WSCRLF WHDFRM RCDCR WRTSSP WRTSS1 WRTSTR WRTST1 WRTST2 wrtsix wrlp wrsoj SWRTCH WRTCHR CORERR IERR4 HELP NOMAIL NOUSER SYNER2 SENERR NOPPNM RCVD DAYLIT MAISTR MAIST2 MAIDEC MAI2DG
C00116 00015 SEND LOGGED LOGGE1 LOGTST JBLP JBNXT SENDER JUSTEL MSPG MSNFR MSNSJ SENTTY DPBSTR DPBNAM MSBUFR
C00120 00016 VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
C00125 00017 MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR
C00128 00018 MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR
C00131 00019 NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STAPRO LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO
C00141 00020 RETR RETRX0 ASCERR
C00143 00021 WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEGO MODE MODEUN MODEOK STRU XRSQ
C00146 00022 DECIN DECIN0 SOCK
C00148 00023 BYTE BYTE2 BYTE4 BYTE9
C00149 00024 PASS NOPRVS WRONGP GIVUSR MUSTLG PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE
C00156 00025 GETCOM GETCO1 FLUSCS flcs1 GETCO2
C00159 00026 GETIDX ANAMES
C00160 00027 PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3
C00164 00028 GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
C00168 00029 GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
C00171 00030 DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH DOMARP WATHST MAXSIT IMPOCT
C00175 00031 SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
C00178 00032 GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF
C00184 00033 GETDST MLNCOP MLNB MLNA MLNMIN MLNMOK PRELAY MLFILE MLNMFF MLNMF2 MLNMF0 TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX DSTHNM DSTHNX FOPEN FACTXT DORELA DORELU DORELC DORELF DOREHC DOREHE DORELH DORERR DORNUS DORNU2 HSTCHK HSTOK SCANUS SCANMX MLHOST MLHOSL MLHOS2 POP12J RECRLY RECRL2 RECRL3 RECRLP RECRL0 RECRLE RECOUT RECOU2 GET0E1 GET0E2 GET0E3 GET0E4 GET0E5 GET0E6 GET0E7 GET010 GET011 GET012 GET013 GET014 GET015 GET016 GET017 GET1E1 GET1E2 GET1E3 GET1E4 GET1E5 GET1E6 GET1E7 GET1E8 GET1E9 GET110 GET111 GET112 GET1ER GET0ER COPDOM COPHST COPHS2 COPHOK CHKSTR CHKST0 SKPSPC SKPSP0 SKPSPG SKPSGL
C00223 00034 TRYFOR TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT
C00228 00035 DIROUT DIROU1 DIROU2 DIRO25 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOFL DIEOF0 DIEOF1 DIFINI DIEOML DIMLFL DIERR3
C00236 00036 RMDWAK RMDSYS OMLGET OMLGT1 OMLOUT OMLOPN OMLBUF OMLNAM PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
C00240 00037 GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE
C00243 00038 DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR OCONER
C00247 00039 GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK
C00252 00040 NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
C00255 00041 ILEVEL DNTSAY timout SXACTV LOOK
C00257 00042 GETHNM COPYUS GOTUS CPYHST CPYDUN HSTTAB HSTSIX WHYWHY
C00261 00043 BYE BYE1 BYE2 ERRKIL QUIT QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
C00268 ENDMK
C⊗;
;⊗ history FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ROBUF ICPBLK ICPSTS ICPSKT HOSTNO CONECB CNIBTS OURSTR HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD maxpth REVPTH COLONS MFRBUF MSJBUF SNDNAM XRFBUF XRFBZZ XRFBBP XRRBBP XXBUF XXBZZ XXBBP NBUFS DSKIBF DSKOBF MFDIBF OLDIBF RLYOBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC RLY MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS WAITST WATSIT
TITLE SMTPSR SMTP server
COMMENT ⊗ History (please record changes):
03 May 83 ME IP/TCP code under FTIP.
04 May 83 ME EOMAIL wakes up remind phantom to deliver the mail.
17 May 83 JJW Fix to convert IP addresses to/from HOSTS2 format.
15 May 83 ME MLNLFF now checks host name in To: line to see if it's ours.
Quoting with "\" in From: line works, but leave "\" in line
for local mail hdr; MAIL should be fixed to accept this
form in a destination. RSET cmd clears GOTFRM. MLNB refuses
to accept mail for relaying (starts with "@" and contains
":" or "," -- already refused if contained "@...:").
19 May 83 ME MLFILE now handles mail to "@file"@ourname correctly.
23 May 83 ME RCPT checks to see if the user is really logged in for SEND,
and returns a 450 failure reply if not.
10 Jun 83 ME Put more specific error replies in MAIL/GETFRM.
11 Jun 83 ME Conversion to HOSTS3. Also uses dotted host number string
if no known host name for given host number. Allows connection
if from any of our alias host numbers when system down. Uses
exec 355 ptr to our host numbers.
13 Jun 83 ME Bug fixed at MLHOST, infinite loop resetting aobjn ptr.
23 Jun 83 ME Turned off "verbose" mode, to speed up I-level.
24 Jun 83 ME Fixed ILEVEL's verbose mode output buffer check to be more
conservative to avoid attempt to reschedule at I-level.
04 Jul 83 ME Fixed SCHEK to check for RFCS and RFCR instead of just CLS bits,
since a completely closed connection shows no bits at all.
Separated IVERBOSE from VERBOSE; former causes I-level typeout.
05 Jul 83 ME Fixed PUTCH2 and GETCH7 to include 32↔33 in ASCII/WAITS
character conversion (previous done to FTP/FTPSER).
04 Aug 83 ME SYNERR, NOMAIL and NOUSER errors in recipient include RCPT
line in error reply. Fixed START to clear HSTADR in case
core image is restarted, since JOBFF is reset by RESET, thus
allowing any mapped in host table's core to be reused and
hence clobbered.
11 Aug 83 ME Change NORLAY to return 550 instead of 553 (for no relaying
implemented), and fixed GETDST to take direct return to
get to NORLAY if first host name parsed isn't us (implying
relaying request).
12 Aug 83 ME IMPSTR fixed not to outstr stuff twice in verbose mode;
other routines fixed to type out text in verbose mode,
being more consistent (call PUTCH1 instead of PUTCHR).
GETDST sets SYNCOD with code of any syntax error; SYNERR
returns octal error code in SMTP reply.
17 Aug 83 ME Fixed bug in SYNERR that made it not include error code but
our host name in the syntax error text.
18 Aug 83 ME Made SYNERR and GETxEx to report last char plus error code.
19 Aug 83 ME Fixed DNTSAY (on user interrupt) and GETCH1 not to use SYNCH,
since SMTP protocol doesn't have DataMarks; the 200 bit must
be zero. GET0E6 halts after changing job name to 'GET ME'.
20 Aug 83 ME MLNMIN accepts "." in mailbox name, in case foreign host
is sending us a message to be relayed to another host.
Removed halt at GET0E6 except when A holds zero (null).
22 Aug 83 ME Fixed GETDST (1) to clear any previous overflow of XRFBUF
and (2) to zero XRFBBP to stop saving text in XRFBUF after
recipient line finished at MLNCOP. This should fix the
erroneous "syntax error" reply we sometimes have been
returning (after long msg followed by second msg using
same connection).
30 Aug 83 ME Removed halt at GET0E6 for final case (A holds null),
since the bug was fixed and this halt really happens
when the foreign mailer has a syntax problem.
16 Sep 83 JJW Removed FTHST3 switch and non-HOSTS3 code. Changed failure
return from HSTNUM to call HNUMST in NETWRK.
26 Oct 83 ME Made WRHDR use downarrows instead of double quotes to
quote the "from:" text for local mail header, etc.
GETFRL maintains spaces, tabs and brackets in name that
is quoted with double quotes.
7 Dec 83 ME GETDST fixed partially to allow double quotes around dest
(to make "@FILE"@SU-AI work).
5 Mar 84 ME Fixed IMPSTH always to put out domain string (.ARPA).
IMPSTH and RCVD also both now use our host name from OURSTR,
which is set up by GETHNM using NETWRK and lowcore 355 table.
RCVD includes .ARPA in line, omits last part of "with TCP/SMTP".
When host table includes ".ARPA" in names, flush refs to
DOMARP to avoid duplicating the .ARPA.
6 Mar 84 ME DOMARP removed at same time .ARPAs included in new host table.
28 Apr 84 ME DORELA in GETHST sets up MAIL's destination to handle SMTP
mail relaying, using /-E switch to indicate this to MAIL.
22 May 84 ME Kludge in DORELA to accept CCRMA as destination host for relay.
Mail relaying put up.
23 May 84 ME DORERR returns flag indicating unknown host (SYNCOD negative),
so that RCPT can return a reply saying unknown host. Also,
if SCANUS fails, DORNUS returns code causing RCPT to reply
that we're not the claimed host (either for mail relaying
or direct mail). Also, attempts to mail @sail,user@score
will now get syntax error reply (from MLFILE).
13 Nov 84 JJW GETDST allows "user%host" syntax to specify relaying.
14 Jun 85 ME WRHDR leaves empty /FROM↓↓ switch in header for MAIL if
the remote host said MAIL FROM:<> (return failed mail msg).
17 Mar 86 ME Fixed GETFRM to reject return paths that have two unquoted
colons in them (e.g., @score:@sushi:user@sierra). There
are at least a couple of hosts that have been observed
giving us such bad return paths: SCRC-Quabbin and SRI-AI.
18 Mar 86 ME Added FTLFRM, under which we log all MAIL FROM:<...> lines in
relay-log file for any mail relayed BEFORE reaching WAITS.
(We always log any mail being relayed through WAITS.) This is
for debugging funny mail with extra colon, since yesterday's
fix didn't stop this stuff from being accepted by WAITS.
5 Apr 86 ME Re-worked PRELAY and MLNMIN to allow multiple percent-signs
and to relay the message to the host following the last
percent-sign. But disabled at MLNMIN+10 (see comment) until
MAIL can accept address like User%Host1%Host2.
14 May 86 ME UNKHST tells what our host name is, when rejecting some
host name as not ours.
history: end of comment ⊗
PRINTS /Have you listed your changes at History: on page 2?
/
IFNDEF FTLFRM,<↓FTLFRM←←0> ;nonzero to log mail if relayed before here
IFNDEF FTIP,<↓FTIP←←1> ;IP/TCP version
IFNDEF FTMUSF,<↓FTMUSF←←1> ;kludge to allow relaying to CCRMA (SAIL only!)
IFDEF F2UUO,<↓FTMUSF←←0> ;set to zero if not at SAIL
IFE FTIP,<
PRINTS/To put up a new SMTPSR, save core image as RFC031.DMP[NET,SYS].
/
>;IFE FTIP
IFN FTIP,<
PRINTS/To put up a new SMTPSR, save core image as TCP031.DMP[NET,SYS].
/
>;IFN FTIP
IFNDEF FTREQL,<FTREQL←←0> ;set nonzero to require login for main stuff
IFN FTREQL,<PRINTS/Will require login for file operations.
/>
IFNDEF FTPSKT,<FTPSKT←←31>
IFNDEF VERBOSE,<VERBOSE←←0> ;SET TO 0 FOR QUIET
IFNDEF IVERBOSE,<IVERBOSE←←0> ;SET TO 0 FOR QUIET, else typeout at I-level
IFNDEF FTMSJ,<FTMSJ←←0> ;Nonzero means extract subject from mail
;Zero now to let MAIL program find the subject
IFNDEF FTFRM,<FTFRM←←0> ;Nonzero means extract "from: line" from mail
;Zero now since SMTP has explicit "from" text
EXTERN JOBFF,JOBSA
; ACCUMULATOR DEFINITIONS:
FLG←0 ;High order bit for EOF from MAIL command, see below
↓A←1 ;TEMP
↓B←2 ;TEMP
C←3
D←4
E←5
F←6
FLG2←7 ;USED TO INSERT INITIAL SPACES IN MLFL LINES
IFN FTFRM,<
MBP←10 ;USED FOR MAIL "FROM" LINE FINDER
MCH←11 ;DITTO
>;IFN FTFRM
IFN FTMSJ,<
MSJ←12 ;USED FOR MAIL "SUBJECT" LINE FINDER
>;IFN FTMSJ
T←13
↓T1←14
↓T2←15
↓T3←16
↓P←17 ;PUSH DOWN LIST
; STORAGE ASSIGNMENTS:
PDLL←←60 ;PDL LENGTH
PDL: BLOCK PDLL
DIBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM IMP DATA CONNECTION
DOBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO IMP DATA CONNECTION
FOBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM (DSK,MTA,DTA,ETC.)
FIBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO (DSK,MTA,DTA,ETC.)
IBUF: BLOCK 3 ;INPUT CONTROL BUFFER HEADER
OBUF: BLOCK 3 ;OUTPUT CONTROL BUFFER HEADER
ROBUF: BLOCK 3 ;buffer header, relay-log output
ICPBLK: 1 ; LISTEN
ICPSTS: 0 ; status
FTPSKT ; listen socket
-1 ; wait flag
=32 ; byte size
ICPSKT: 0 ; foreign socket
HOSTNO: 0 ; foreign host
CONECB: BLOCK 7
CNIBTS: 0 ;INTERRUPT LEVEL ROUTINES PUTS BITS HERE
OURSTR: BLOCK =10 ;our host name gets stuck here
HSTSTR: BLOCK =10 ;HOST STRING
PRIVS: 0 ;SAVE USER'S PRIVILEGES HERE
UFDFIL: 0
SIXBIT/UFD/
0
SIXBIT/ 1 1/
PASMTA: SIXBIT/GODMOD/
15
0
0
PRVMTA: SIXBIT /GODMOD/
14
IOWD 17,PRVBUF
PRVBUF: BLOCK 13
PASWD: 0 ;PASSWORD RETURNED HERE IF INF
PRIVWD: 0 ;PRIVILEGES RETURNED HERE
0 ;LAST LOGIN TIME RETURNED HERE
GRPWD: 0 ;GROUP ACCESS BITS RETURNED HERE
maxpth←←=256
REVPTH: BLOCK 1+maxpth/5 ;MAIL cmd's argument -- reverse path
COLONS: -1 ;count to ensure return path has no extra colon
IFN FTFRM,<
MFRBUF: BLOCK 40 ;FOR "FROM" LINE STORAGE (MAIL cmd's argument)
>;IFN FTFRM
IFN FTMSJ,<
MSJBUF: BLOCK 40 ;FOR "SUBJECT" LINE STORAGE
>;IFN FTMSJ
;; XRSQSW: 0 ; 0 Default scheme, -1 Text-first scheme.
; +1 Recip-first BH 7/28/80
;; XRBBEG: 0 ; Addr of start of buffer
;; XRBTOP: 0 ; Addr of 1st non-used loc (should be = JOBFF)
;; XRBPTR: 0 ; BP to deposit text at
;; XRBCNT: 0 ; If -, # chars free in buffer, else # chars.
;;MAXRCP←←=100 ;max number of recipients we're supposed to handle
SNDNAM: BLOCK 1+MAXPTH/5 ;argument of HELO command, sending host's domain&name
XRFBUF: BLOCK 1+MAXPTH/5 ; Block for remembering one recipient
XRFBZZ: 0 ; Must stay zero, overflow test
XRFBBP: 0 ; BPT for adding recipient
XRRBBP: 0 ; BPT for re-scanning recipient
XXBUF: BLOCK 1+MAXPTH/5 ; Block for remembering one recipient line
XXBZZ: 0 ; Must stay zero, overflow test
XXBBP: 0 ; BPT for adding recipient
;; XRFOBP: 0 ; BPT after last added recipient
;; XRFHBP: 0 ; Copy of OBP as flag for header generation
NBUFS←←23 ;optimum number of disk buffers
;I/O BUFFERS
DSKIBF: BLOCK NBUFS*203 ;A WHOLE TRACK'S WORTH FOR THE MAIN DISK CHANNELS
DSKOBF: BLOCK NBUFS*203
MFDIBF: BLOCK 2*203 ;NOT WORTH IT FOR THESE LOW-USE ONES
OLDIBF: BLOCK 2*203
RLYOBF: BLOCK 2*203 ;output buffers for relay-log entry mail file
LOURH3←←10 ;number of host numbers to allow for ourselves
OURH3: BLOCK LOURH3 ;our host number(s), copied from system via lowcore 355
; VARIABLE DEFINITONS:
LCSS: 0 ;LOCAL CONTROL SEND SOCKET
LCRS: 0 ;LOCAL CONTROL RECEIVE SOCKET
FCSS: 0 ;FOREIGN CONTROL SEND SOCKET
FCRS: 0 ;FOREIGN CONTROL RECEIVE SOCKET
LDSS: 0 ;LOCAL DATA SEND SOCKET
LDRS: 0 ;LOCAL DATA RECEIVE SOCKET
FDRS: 0 ;FOREIGN DATA RECEIVE SOCKET
FDSS: 0 ;FOREIGN DATA SEND SOCKET
UPPN: SIXBIT/NETGUE/ ;"LOCAL" PPN OF USER FTP
ALIPPN: SIXBIT/NETGUE/ ;ALIAS PPN OF USER FTP
UPRG: 'GUE' ;JUST PRG FROM UPPN (FOR CAME IN ILDDEV)
PPNTMP: 0 ;Save user name here until password is given
PASTRY: 0 ;Number of try user has left to guess password
ifn verbose,<
SILENT: 0 ;Hide password from spies running FTPS
>;ifn verbose
DOMODE: 0 ;LEGAL MODES ARE: 0-Stream, 1-Block, 2-Text,
DIMODE: 0 ; 3-Hasp
DOTYPE: 0 ;LEGAL TYPES ARE: 0-Ascii, 1-Image, 2-Local byte,
DITYPE: 0 ; 3-Print file ascii, 4-Ebcdic
IMODES: 1000 ↔ 1010 ↔ 1010
FMODES: 1000 ↔ 1010 ↔ 1010
DOBS: =8 ;BYTE SIZE, DATA CONNECTION OUT
DIBS: =8 ;BYTE SIZE, DATA CONNECTION IN
DOACTV: 0 ;DATA OUT LINE IS ACTIVE
DIACTV: 0 ;DATA IN LINE IS ACTIVE
XACTV: 0
RTYPE: 0 ;REAL TYPE, LATEST GOTTEN FROM USER
RBS: =8 ;REAL BYTE SIZE, LATEST GOTTEN FROM USER
SCHEKF: 0 ;IF MINUS, IT'S TIME TO CHECK IMP STATUS
OUTINSTR:0 ;FOR DATGEN, WHICH OUTPUT SINK TO WRITE CHARS TO
SYNCH: 0 ;IF +, # OF UNMATCHED DATA MARK CHARS (200)
;IF -, # OF UNMATCHED INS INTERRUPTS
;WHILE -, FLUSH ALL INPUT CHARS EXCEPT DM
DIRFLC: 0 ;COUNTER FOR FLUSHING EXTRA DIRECTORY ENTRIES
PATCH: BLOCK 40 ;patch space
; I/O CHANNEL DEFINITONS
IMP←←4 ;CONTROL CONNECTIONS
DIMP←←1 ;DATA IN FROM IMP CHANNEL
DOMP←←0 ;DATA OUT TO IMP CHANNEL
FIMP←←3 ;FILE IN (IN FROM IMP, OUT TO DEVICE) CHANNEL
FOMP←←2 ;FILE OUT (OUT TO IMP, IN FROM DEVICE) CHANNEL
; NOTE: DIMP,FIMP ARE USED TOGETHER,
; SIMILARLY, DOMP,FOMP GO TOGETHER
; SOME OF THE ABOVE ARE USED NON-SYMBOLICALLY IN CODE!!!
.MFD←←5 ;READ MFD FOR VALID MAIL RECIPIENT
.OLD←←6 ;READ OLD MAIL FILE
.PASS←←7 ;USED TO CHECK PASSWORD
UFDC←←10 ;USED TO READ UFD FOR ACCESS CHECK
RLY←←11 ;used to write .FTP file to record mail relay
; FLG bits, left half.
MEOFBT←←1B0 ;EOF on MAIL (must be 4.9 bit!)
USREBT←←1B1 ;User command given, expecting password
PASSBT←←1B2 ;Password given, OK to STOR, etc.
IFN FTFRM,<
MFRWIN←←40000 ;MAIL "FROM" LINE FINDER IS ON THE RIGHT LINE
MFRLUZ←←20000 ;MAIL "FROM" LINE FINDER IS ON THE WRONG LINE
MFRDUN←←10000 ;MAIL "FROM" LINE FINDER IS FINISHED READING IT
>;IFN FTFRM
MFNMF←←4000 ;MLFLNM IN PROGRESS
LFSEEN←←2000 ;LF HAS BEEN EATEN IN INCOMING COMMAND LINE
LISTFL←←1000 ;DO OPERATION IS LIST (OR NLST) AS OPPOSED TO RETR OR STAT
IFN FTMSJ,<
MSJDUN←←400 ;MAIL "SUBJECT" LINE FINDER IS FINISHED READING IT
MSJWIN←←200 ;MAIL "SUBJECT" LINE FINDER IS ON THE RIGHT LINE
MSJLUZ←←100 ;MAIL "SUBJECT" LINE FINDER IS ON THE WRONG LINE
>;IFN FTMSJ
IFE FTMSJ,<
MSJDUN←←0 ;no such bit now
>;IFE FTMSJ
QUOTEF←←40 ;QUOTED STRING IN PROGRESS
LEFTF←←20 ;LEFT JUSTIFIED SIXBIT
;ABOVE ARE LH FLAGS
.MAIL←←1 ;MAIL COMMAND LIKE LOCAL MAIL (SMTP: MAIL)
.XSEN←←2 ;XSEN COMMAND LIKE LOCAL SEND/N (SMTP: SEND)
.XSEM←←4 ;XSEM COMMAND LIKE LOCAL SEND/Y (SMTP: SOML)
.XMAS←←10 ;XMAS COMMAND LIKE LOCAL SEND/M (SMTP: SAML)
;ABOVE ARE RH FLAGS AND MAYN'T BE MOVED
CPOPJ2: AOS (P)
POPJ1: ;I CAN NEVER REMEMBER
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
DEFINE MES(TEXT) <
IFN VERBOSE, <OUTSTR [ASCIZ ⊗TEXT
⊗] >>
DEFINE REPMES(TEXT) <
MOVE E,[POINT 7,[ASCIZ ⊗TEXT
⊗]]
JRST REPMET >
REPMET: PUSHJ P,GSRCI
PUSHJ P,ASCIIE
SOS IMPSTF
JRST FLUSCS
QUANTM←←=60 ;ONE CLOCK "TICK" IS ONE SECOND
;GROUP ACCESS/PRIVILEGE BITS
;None of these symbols are actually used in the code except GROUPS and MASPRV.
;GROUPS is a fullword value but MASPRV must be right half.
REAPRV←←40000
WRTPRV←←20000
MASPRV←←1
SYSPRV←←2
SCYPRV←←4
DECPRV←←10
ACTPRV←←20
CSPPRV←←40
GROUPS←←47 ;ALL OF THE ABOVE.
repeat 0,<
WAITST: 0 ;WAITS site number goes here
WATSIT←←263 ;low core location containing WATCPU,,WATSIT
>;repeat 0
; DEFINITIONS OF A "GLOBAL" NATURE
ERRBTS ←← 0;
UFDN←←20 ;NUMBER OF WORDS IN A DIRECTORY ENTRY
DEFINE X(BIT,VAL) <
BIT ← VAL ↔ ERRBTS ← ERRBTS!VAL
>
IFE FTIP,<
X(RSET,400) ; HOST SEND US A RESET
X(CTROV,1000) ; HOST OVERFLOWED OUR ALLOCATION
X(HDEAD,2000) ; HOST IS DEAD
>;IFE FTIP
X(IODEND,020000); END OF FILE
X(IOBKTL,040000); BLOCK TOO LARGE
X(IODTER,100000); DEVICE ERROR
X(IODERR,200000); DATA ERROR
X(IOIMPM,400000); IMPROPER MODE
RFCS ←← 200000 ; RFC SENT
RFCR ←← 100000 ; RFC RECEIVED
CLSS ←← 040000 ; CLS SENT
CLSR ←← 020000 ; CLS RECEIVED
RFC ←← RFCS ! RFCR
CLS ←← CLSS ! CLSR
STLOC ←← 1
LSLOC ←← 2
WFLOC ←← 3
BSLOC ←← 4
FSLOC ←← 5
HNLOC ←← 6
EXTERNAL JOBCNI,JOBAPR,JOBREL,JOBFF
DEFINE NAMES <
; X(RNTO) ;MUST BE INDEX 1 WHEN DEFINED
; X(USER)
; X(PASS)
; X(TYPE)
; X(SOCK)
; X(STRU)
; X(MODE)
; X(BYTE)
; X(RETR)
; X(STOR)
; X(APPE)
; X(RNFR)
; X(DELE)
X(MAIL)
; X(MLFL)
; X(STAT)
X(HELP)
; X(XCWD)
; X(CWD)
; X(BYE)
; X(ABOR)
; X(LIST)
; X(NLST)
X(SEND,XSEN) ;EXPERIMENTAL, SEND/N
X(SOML,XSEM) ;EXPERIMENTAL, SEND/Y
X(SAML,XMAS) ;EXPERIMENTAL, SEND/M
; X(XRSQ) ; XRCP scheme selection
; X(XRCP) ; XRCP command itself
; X(ACCT)
; X(ALLO)
X(HELO)
X(RCPT) ;specifies a recipient
X(QUIT,BYE)
X(DATA)
X(RSET,ABOR)
X(NOOP)
>
INTINP ←← 000010
INTIMS ←← 000020
INTINS ←← 000040
INTCLK ←← 000200
;OPCODE DEFINITONS:
DEFINE INTOFF <INTMSK 1,[0]>
DEFINE INTON <INTMSK 1,[-1]>
OPDEF PTOCNT [PTYUUO 3,]
;ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO
; ICP: INITIAL CONTROL LINK CONNECTION ESTABLISHMENT ROUTINE
ICP: ;THIS ROUTINE ESTABLISHES BOTH CONTROL CONNECTIONS
; TO THE USER FTP, AND SKIP RETURNS. NON-SKIP RETURN
; INDICATES SOME KIND OF FAILURE.
MTAPE IMP,ICPGTO ;GET SYSTEM DEFAULT TIMEOUTS
MOVE A,ICPGTO+1 ;GET SYSTEM DEFAULT TIMEOUTS IN A
OR A,[17,,400000] ;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
MOVEM A,ICPSTO+1
MTAPE IMP,ICPSTO ;SET TIMEOUTS
IFE FTIP,<
SETZM CONECB
SETZM CONECB+FSLOC ;DON'T WAIT FOR CONNECTION
>;IFE FTIP
IFN FTIP,<
MOVEI A,1
MOVEM A,CONECB ;Do a LISTEN, not a connect
SETOM CONECB+WFLOC ;Wait for (duplex) connection
SETZM CONECB+FSLOC ;Listen for any foreign port
SETZM CONECB+HNLOC ;Any foreign host will do
>;IFN FTIP
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
IFE FTIP,<
MOVE A,FCRS
MOVEM A,CONECB+FSLOC
MOVE A,HOSTNO
MOVEM A,CONECB+HNLOC
>;IFE FTIP
MOVEI A,10
MOVEM A,CONECB+BSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION OUT
IFN FTIP,<
MOVE A,CONECB+FSLOC ;get foreign port number
MOVEM A,FCSS ;new FTP has all foreign port nbrs the same
MOVEM A,FCRS
MOVEM A,FDRS
MOVEM A,FDRS
MOVE 0,CONECB+HNLOC ;get foreign host number
MOVEM 0,HOSTNO ;save
>;IFN FTIP
IFE FTIP,<
MOVE A,LCRS
MOVEM A,CONECB+LSLOC
MOVE A,FCSS
MOVEM A,CONECB+FSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION IN
MOVEI A,4
MOVEM A,CONECB
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
MTAPE IMP,CONECB ;WAIT FOR OUT CONNECTION
>;IFE FTIP
STATZ IMP,ERRBTS ;TIMEOUT? (OR OTHER RANDOM ERROR)?
JRST ICPTO ; YES
PUSHJ P,ICPCHK
IFE FTIP,<
MOVE A,LCRS
MOVEM A,CONECB+LSLOC
MTAPE IMP,CONECB ;WAIT FOR IN CONNECTION
STATZ IMP,ERRBTS ;TIMEOUT OR OTHER ERROR?
JRST ICPTO ; YES
>;IFE FTIP
JRST CPOPJ1
ICPCHK: MOVE A,CONECB+STLOC
TRNN A,-1
STATZ IMP,ERRBTS
JRST ICPX
POPJ P,
ICPX:
IFE FTIP,<
POP P,A ;RETURN UPLEVEL ON ERROR
MES (Error in control connections)
>;IFE FTIP
IFN FTIP,<
IFN VERBOSE<
OUTSTR [ASCIZ/⊗Error in control connections: /]
MOVE 0,A ;Error code where MTPERR wants it
PUSHJ P,MTPERR ;Print error message
>;IFN VERBOSE
POP P,A
>;IFN FTIP
POPJ P,
ICPTO: ;ICP Time Out
MES (ICP times out)
MOVE A,['KILL-1']
MOVEM A,KFLAG
JRST QUIT
KFLAG: 0
ICPGTO: =16 ↔ 0
ICPSTO: =15 ↔ 0
;IDCON IDCONZ IDCONI IDCNFI IDCNFO IDCNFX IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCONS IDCONB IDCONP IDCOND IDCONF IDSOCS IDSOCK IDSOC0 IDSOC1 IDSOC2
repeat 0,<
; IDCON: INITIIZE DATA LINK CONNECTION ROUTINE
; THIS ROUTINE WILL INITIALIZE A DATA CONNECTION TO THE USER.
; CALL: MOVEI B,0 ;FOR DATA OUT CONNECTION
; MOVEI B,1 ;FOR DATA IN
; PUSHJ P,IDCON
; ERROR RETURN
; SUCCESS RETURN
IDCON:
IFN VERBOSE, <
OUTSTR [ASCIZ /Initializing data link /]
JUMPN B,.+2
OUTSTR [ASCIZ /out/]
JUMPE B,.+2
OUTSTR [ASCIZ /in/] >
PUSHJ P,IDSOCK ;TELL USER WHICH DATA SOCKET WE'RE USING
MOVE A,DOTYPE(B)
MOVE A,IMODES(A)
HRRM A,IDCONI
MOVE A,IDCONB(B)
MOVEM A,IDCONI+2
DPB B,[POINT 4,IDCONI,12]
DPB B,[POINT 4,IDCNFI,12]
DPB B,[POINT 4,IDCNFO,12]
DPB B,[POINT 4,IDCONC,12]
DPB B,[POINT 4,IDCNQ1,12]
DPB B,[POINT 4,IDCNQ2,12]
DPB B,[POINT 4,IDCONW,12]
IDCONZ: DPB B,[POINT 4,IDCONY,12]
IDCONI: INIT 000,000
SIXBIT /IMP/
XWD DOBUF,DIBUF
JRST NOIMP
JUMPE B,IDCNFO
IDCNFI: INBUF 000,0
JRST IDCNQ1
IDCNFO: OUTBUF 000,0
IDCNQ1: MTAPE 000,ICPGTO ;GET SYSTEM DEFAULT TIMEOUTS
MOVE A,ICPGTO+1 ;GET SYSTEM DEFAULT TIMEOUTS IN A
OR A,[17,,400000] ;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
MOVEM A,ICPSTO+1
IDCNQ2: MTAPE 000,ICPSTO ;SET TIMEOUTS
CAIN B,1 ;ARE WE RECEIVING DATA?
IDCONW: MTAPE 000,[=13↔1] ; YES, GIVE ALLOCATION
SETZM CONECB
MOVE A,LDSS(B)
MOVEM A,CONECB+LSLOC
MOVE A,FDRS(B)
MOVEM A,CONECB+FSLOC
IFE FTIP,<
MOVE A,HOSTNO
MOVEM A,CONECB+HNLOC
>;IFE FTIP
IFN FTIP,<
MOVE 0,HOSTNO
PUSHJ P,H2TOIP ;Get IP address
JFCL ;Lose!
MOVEM 0,CONECB+HNLOC
>;IFN FTIP
MOVE A,DOBS(B)
MOVEM A,CONECB+BSLOC
SETZM CONECB+WFLOC ;DON'T WAIT FOR CONNECTION
IDCONC: MTAPE 000,CONECB ;INITIATE DATA CONNECTION W/ USER
IDCONX: INTOFF ;ARRIVE HERE IF WE MUST WAIT FOR CONNECTION
IDCONY: MTAPE 000,IDCONS ;GET STATUS OF DIMP
INTON
MOVE A,IDCONS+1(B)
TRNE A,77 ;ANY ERROR CODES?
POPJ P, ; YES
TLNE A,CLS ;ANYBODY CLOSING CONNECTION?
POPJ P, ; YES
TLC A,RFC
TLCN A,RFC ;CONNECTION COMPLETE?
JRST IDCONF ; YES, SUCCESS RETURN
ifn verbose,<
tlne a,200000 ;rfcs?
outchr ["S"]
tlne a,100000 ;rfcr?
outchr ["R"]
>;verbose
PUSHJ P,@IDCOND(B)
XCT IDCONZ ;THIS INSTRUCTION MAKES IDCON REENTRANT
; - OR ENOUGH SO TO WORK, ANYWAY!
JRST IDCONX
IDCONS: 2 ↔ 0 ↔ 0
IDCONB: XWD DOBUF,0
XWD 0,DIBUF
IDCONP: POINT 6,DOBUF+1,11
POINT 6,DIBUF+1,11
IDCOND: DOWAIT
DIWAIT
IDCONF: MES (...done)
MOVE A,DOBS(B) ;GET CONNECTION BYTE SIZE
DPB A,IDCONP(B) ;SET BYTE SIZE IN BUFFER HEADER
JRST CPOPJ1
IDSOCS: ASCIZ /255 SOCK 0000000000XX/
IDSOCK: PUSHJ P,IDSOC0 ;PUT SOCKET NUMBER INTO ABOVE STRING
MOVEI D,15 ;PUT CRLF INTO ABOVE STRING
IDPB D,C
MOVEI D,12
IDPB D,C
SETZ D,
IDPB D,C
MOVE E,[POINT 7,IDSOCS]
MOVEI A,DOMP
ADD A,B ;C(A) = DIMP or DOMP
PUSHJ P,GSR ;GET PERMISSION TO OUTPUT ON CONTROL LINK
PUSHJ P,ASCIIE
SOS IMPSTF
POPJ P,
IDSOC0: MOVE C,[POINT 7,IDSOCS+1,27] ;POINTS TO " " AFTER "SOCK" IN IDSOCS
MOVE D,LDSS(B) ;GET DATA SOCKET NUMBER
IDSOC1: IDIVI D,12
PUSH P,E ;PUSH LOW ORDER DIGIT ONTO STACK
SKIPE D ;WAS IT HIGH ORDER DIGIT ALSO?
PUSHJ P,IDSOC1 ; NO, GET ANOTHER DIGIT
IDSOC2: POP P,D ;GET DIGIT
ADDI D,"0" ;CONVERT TO ASCIZ
IDPB D,C ;STUFF INTO STRING
POPJ P, ;GET NEXT DIGIT OR RETURN IF NONE
>;repeat 0
;ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
;; ILDDEV - INITIALIZE LOCAL DATA DEVICE
;;THIS ROUTINE DOES THE NECESSARY OPEN'S, LOOKUP'S OR ENTER'S REQUIRED
;;SO THAT INPUT OR OUTPUT UUO'S ON THE CHANNELS FIMP, FOMP WILL FUNCTION.
;;NOTE: THE LOCAL DATA DEVICE NEED NOT NECCESSARILY BE THE DISK.
;; CALL: MOVE C,[<DEVICE NAME IN SIXBIT>]
;; MOVE D,[<PPN IN SIXBIT>]
;; MOVE E,[<XWD <FILE EXTENSION IN SIXBIT>,0]
;; MOVE F,[<FILE NAME IN SIXBIT>]
;; MOVEI B,1 (FOR DATA OUT TO IMP, LOCAL LOOKUP)
;; ,5 (FOR STAT, LOCAL LOOKUP, NO DATA TRANSFER)
;; ,2∨6 (FOR DATA IN FROM IMP, LOCAL ENTER)
;; (6 FOR MAIL OR MLFL, COPIES OLD FILE LATER)
;; ,3 (FOR DATA IN FROM IMP, LOCAL UPDATE)
;; ,10 (FOR RNTO OR DELE)
;; ,21 (FOR RNFR, DOES LOOKUP BUT CHECKS WRITE ACCESS)
;; PUSHJ P,ILDDEV
;; ERROR RETURN
;; SUCCESS RETURN
ILDDEV: SETZM UFDOKF# ;FLAG WHERE -1 MEANS DON'T CHECK UFD PROTECTION
CAIN B,6 ;HERE FROM MAIL OR MLFL?
SETOM UFDOKF ;YES
TRNN D,-1 ;WAS A PROGRAMMER NAME SPECIFIED?
MOVE D,ALIPPN ; NO, USE THE DEFAULT PPN
CAIN B,10
JRST ILDSTT ;DON'T CHANGE STORED FILENAME FOR RNTO OR DELE
MOVEM C,ERRDEV#
MOVEM F,ERRFIL#
HLLZM E,ERREXT#
MOVEM D,ERRPPN#
ILDSTT: TRZ B,4
TLZ FLG,(MEOFBT) ;STAYS 0 EXCEPT FOR MAIL
IFN VERBOSE, <
OUTSTR [ASCIZ /Opening local file system... /]
>
SETZM ERRTYP# ;THIS WILL INDICATE WHEN ERROR HAPPENS
MOVEM C,ILDD+1 ;store device name for OPEN
MOVE A,DOTYPE
TRNE B,2
MOVE A,DITYPE
MOVE A,FMODES(A)
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;SKIP IF NOT DISK
TRO A,200 ;***** ONLY IF DEVICE IS DISK!!
MOVEM A,ILDD
MOVEI A,2 ;ASSUME RENAME, USE INPUT CHANNEL
TRNE B,10 ;FORGET OPEN STUFF IF RENAMING
JRST DPBIT
MOVE T,B
ANDI T,3
MOVE A,[FOBUF
FIBUF,,0
FIBUF,,FOBUF]-1(T) ;BUFFER STRUCTURE
MOVEM A,ILDD+2
MOVE A,[2↔3↔3]-1(T) ;CHANNELS
DPBIT: DPB A,[POINT 4,ILDDO,12] ;DEPOSIT CHANNEL NUMBERS EVERYWHERE.
DPB A,[POINT 4,ILDDL,12]
DPB A,[POINT 4,ILDDE,12]
DPB A,[POINT 4,ILDDE1,12]
DPB A,[POINT 4,ILDDL1,12]
DPB A,[POINT 4,ILDDUG,12]
DPB A,[POINT 4,ILDL69,12]
DPB A,[POINT 4,ILDE69,12]
DPB A,[POINT 4,ILDDRN,12]
DPB A,[POINT 4,ASSHOL,12] ;YA MISSED ONE!!!
DPB A,[POINT 4,ILDVC1,12]
DPB A,[POINT 4,ILDVC2,12]
HRRM A,ILDVCH
TRNE B,10 ;NO OPEN ON RNTO
JRST NOOPEN ; BECAUSE RNFR DID IT
ILDDO: OPEN 000,ILDD
POPJ P, ;ERROR RETURN, CAN'T OPEN DEVICE
NOOPEN:
AOS ERRTYP
IFN VERBOSE, <OUTSTR [ASCIZ / OPEN/]>
ILDVCH: MOVEI T,000 ;CHANNEL NUMBER
DEVCHR T,
TLNN T,200000 ;SKIP IF DISK
JRST [AOS ERRTYP↔JRST ACCOK]
ILDVC1: GETSTS 000,T
TRO T,200
ILDVC2: SETSTS 000,(T)
MOVEI T,217
MOVEM T,ILDD
SETZM ILDD+2
OPEN UFDC,ILDD ;CHANNEL FOR UFD LOOKUPS TO CHECK FILE ACCESS
JRST [MES(Access check OPEN failure)↔POPJ P,]
MOVEM D,ILDD ;PREPARE TO LOOKUP UFD
CAMN D,[' 1 1'] ;DON'T ACCESS CHECK MFD IF READING UFD
JRST NOUFDC
HRLZI T,'UFD'
MOVEM T,ILDD+1
SETZM ILDD+2
MOVE T,[' 1 1']
MOVEM T,ILDD+3
LOOKUP UFDC,ILDD
JRST [MES(No UFD for access check)↔POPJ P,]
PUSHJ P,GRPCHK
SKIPE UFDOKF ;DO WE NEED TO CHECK THE UFD PROTECTION?
JRST NOUFDC ;NO
PUSHJ P,ACCCHK ;CHECK ACCESS
JRST [MES(UFD access prohibited)↔POPJ P,]
NOUFDC: MOVEM D,ILDD+3 ;Store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
LOOKUP UFDC,ILDD ;NOW WE CHECK THE ACTUAL FILE
JRST [AOS ERRTYP↔JRST ACCOK]
CAMN D,[' 1 1'] ;IF READING A UFD,
PUSHJ P,GRPCHK ; NOW IS THE TIME FOR GROUP CHECKING
PUSHJ P,ACCCHK ;CHECK FILE ACCESS
JRST [MES(File access prohibited)↔POPJ P,]
RELEAS UFDC, ;DONE READING FILE FOR ACCESS CHECK
ACCOK: AOS ERRTYP
MOVEM D,ILDD+3 ;store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
TRNN B,1 ;going to do input?
JRST ILDDET ;no
PUSH P,JOBFF ;RECYCLE BUFFER SPACE
MOVEI T,DSKIBF ;FIXED LOCATION
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDL1 ;use more buffers for disk
ILDL69: INBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDL1: INBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF ;JUST IN CASE SOMEBODY ELSE USES IT
ILDDL: LOOKUP 000,ILDD
JRST [CAIN B,3 ;IF UPDATING, LOOKUP FAILURE IS OK
JRST ILDDE0
MES(LOOKUP failed)
POPJ P, ; OTHERWISE, IT ISN'T
]
ILDDE0:
;; SETZM FOBTSL ;SET UP FOR IMAGE INPUT
repeat 0,<
MOVEI T,1
LSH T,@DOBS
SUBI T,1
MOVEM T,FOMASK
>;repeat 0
ILDDET: TRNN B,2
JRST ILDDD ;INPUT ONLY
PUSH P,JOBFF
MOVEI T,DSKOBF
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDE1 ;use more buffers for disk
ILDE69: OUTBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDE1: OUTBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF
MOVEM D,ILDD+3 ;REPLACE ZAPPED PPN
HLLZS ILDD+1 ;DATE75
SETZM ILDD+2
repeat 0,<
MOVE T,[ILDD,,OMLNAM] ;SAVE FILE FOR LATER LOOKUP IN CASE IT'S MAIL
BLT T,OMLNAM+3
>;repeat 0
ILDDE: ENTER 000,ILDD
JRST [MES(ENTER failed)↔POPJ P,]
repeat 0,<
MOVEI T,=36
MOVEM T,FIBTSL
SETZM FIWORD
MOVS T,DIBS
LSH T,6
IOR T,[POINT 0,FIWORD]
MOVEM T,FIBPT
>;repeat 0
CAIN B,3 ;UPDATE FILE?
ILDDUG: UGETF 000,A ;DOES USETO TO NEXT FREE
ILDDD: MOVE T,DOTYPE
TRNE B,2
MOVE T,DITYPE
XCT ILDSS1(T)
TRNE B,1
DPB T,[POINT 6,FOBUF+1,11]
TRNE B,2
DPB T,[POINT 6,FIBUF+1,11]
TRNN B,10 ;RENAME TIME
JRST ILD123
ILDDRN: HLLZS ILDD+1
SETZM ILDD+2
ASSHOL: RENAME 000,ILDD ;DO IT
JRST [MES(RENAME failed)↔POPJ P,]
ILD123: MES ( Done)
JRST CPOPJ1
ILDD: BLOCK 4
ILDSS1: MOVEI T,7 ;TABLE OF BYTE SIZE GOBBLERS BY XFER TYPE
MOVEI T,=36
PUSHJ P,ILDSS2 ;LOCAL, NEED DOBS OR DIBS
ILDSS2: MOVE T,DOBS
TRNE B,2
MOVE T,DIBS
POPJ P,
ACCCHK: MOVE T,ILDD+2 ;GET PROTECTION
TLZ T,600000 ;FLUSH THESE LOSING BITS
SKIPN OWNER ;IF USER HAS GROUP ACCESS PRIVS TO THIS UFD,
CAMN D,UPPN ; OR IF FILE PPN IS USER'S PPN,
JRST OWNACC ; USE OWNER ACCESS
LSH T,3 ;ELSE EITHER LOCAL OR GUEST ACCESS
TLNN FLG,(PASSBT) ; DEPENDING
LSH T,3
OWNACC: TRNE B,36 ;IF ANYTHING OTHER THAN STRAIGHT READ,
LSH T,1 ; CHECK WRITE ACCESS
TLNN T,200000 ;THE MAGIC BIT SHOULD ALWAYS BE HERE NOW
AOS (P) ;ACCESS OK
POPJ P,
GRPCHK: SETZM OWNER# ;THIS WILL FLAG OWNER ACCESS
AOS ERRTYP ;WE'VE FOUND THE UFD
MTAPE UFDC,PRVMTA ;READ RETRIEVAL
POPJ P, ;CAN'T, NO GROUP ACCESS
SETZM PASWD ;JUST IN CASE WE HAVE INF
MOVE T,GRPWD ;GET FILE ACCESS GROUPS FOR THIS UFD
AND T,[GROUPS] ;JUST THE RIGHT BITS PLEASE
HRRZ A,ILDD ;PRG OF TARGET UFD
CAME A,UPRG ;PRG OF OUR USER
TRZ T,MASPRV ;NOT THE SAME, NO MAS ACCESS
TLO T,REAPRV!WRTPRV ;ALSO ALLOW REA AND WRT ACCESS
TDNE T,PRIVS ;DOES USER HAVE ANY CORRESPONDING PRIVS?
SETOM OWNER ;YES! ALLOW OWNER ACCESS
POPJ P,
;⊗ START %SITE% REGO
; MAIN PROGRAM STARTS HERE
START: JFCL
RESET
SETZM HSTADR ;no host table mapped in now, since JOBFF reset
OUTSTR [ASCIZ/SMTPSR started
/]
MOVE [SIXBIT/SMTPSR/]
SETNAM
MOVE P,[XWD -PDLL,PDL] ;GET A PUSH DOWN LIST
CLKINT =30*=60*=60
SETZM PRIVS ;PARANOID? ME, PARANOID?
SETZ FLG, ;Zero flags
IFN FTREQL,<
SETZM USEROK ;nonzero indicates login done (can't be flag in FLG)
>;IFN FTREQL
SETO B,
GETLIN B
MOVEM B,TTYNUM#
SETOM RECOPN# ;no relay-log file open
SETZM OURSTR ;clear our own host string
SETZM OURH3 ;clear all our host numbers
MOVE T1,[OURH3,,OURH3+1] ;BLT source,,dest
BLT T1,OURH3+LOURH3-1 ;clear entire array
MOVSI T1,377777
SETPR2 T1, ;peek at system
JRST [ OUTSTR [ASCIZ/?? SETPR2 failed./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
SKIPL T1,400000!355 ;lowcore 355 is aobjn ptr to our HOSTS3 address
JRST [ ;can't tell who we are if no addresses
OUTSTR [ASCIZ /?? No valid host number for us pointed to by exec 355./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
HLRE T2,T1 ;- number of addresses
MOVN T2,T2 ;make positive nbr of host numbers
CAILE T2,LOURH3 ;skip if our table is as at least big as systems
MOVEI T2,LOURH3 ;only store as many as we have room for
MOVSI T3,400000(T1) ;BLT source address -- in system
HRRI T3,OURH3 ;BLT dest -- our table of our host number(s)
BLT T3,OURH3-1(T2) ;copy whole table from system (or what fits)
%SITE%:
repeat 0,<
MOVEI B,WATSIT
PEEK B, ;get WAITS site number from system (CPU,,SITE)
MOVEI B,(B) ;just site number
CAIL B,MAXSIT ;reasonable site number?
MOVEI B,MAXSIT-1 ;no, use unknown site
MOVEM B,WAITST ;remember it for figuring out our host name
>;repeat 0
INIT IMP,1
('IMP')
OBUF,,IBUF
JRST NOIMP
IFE FTIP,<
INIT 17 ; open IMP in dump mode
('IMP')
0 ; no buffers
JRST NOIMP
MTAPE [17 ↔ BYTE (6)1,=10,0,=30,0,0]; set timeouts
MTAPE ICPBLK ; connect → foreign logger
MOVE B,ICPSTS ; check for MTAPE error
TRNE B,77
JRST QUIT
STATZ ERRBTS
JRST QUIT
TLC B,RFC ; for next instruction to win
TLCE B,RFC ; legal socket state?
JRST QUIT
MOVEI A,21
MTAPE A
MOVEM B,LCRS
DPB B,[044000,,ICPS#]
HRROI B,ICPS-1
SETZ C,
OUT B ; send socket from user
CAIA ; won
JRST QUIT
RELEAS
OUTSTR [ASCIZ /Using socket /]
MOVSI B,-14
MOVE D,LCRS
SETZ C,
LSHC C,3
ADDI C,"0"
OUTCHR C
AOBJN B,.-4
OUTSTR [ASCIZ /, connecting to host /]
PUSHJ P,GETHNM
OUTSTR HSTSTR
OUTSTR [ASCIZ/
/]
MOVE A,LCRS
ADDI A,1
MOVEM A,LCSS
ADDI A,1
MOVEM A,LDRS
ADDI A,1
MOVEM A,LDSS
MOVE A,ICPSKT
ADDI A,2
MOVEM A,FCRS
ADDI A,1
MOVEM A,FCSS
ADDI A,1
MOVEM A,FDRS
ADDI A,1
MOVEM A,FDSS
>;IFE FTIP
IFN FTIP,<
MOVEI A,FTPSKT ;listen port
MOVEM A,LCRS ; is used for both send
MOVEM A,LCSS ; and receive of control connection
SUBI A,1 ;port one less
MOVEM A,LDRS ; is used for both send
MOVEM A,LDSS ; and receive of data connection
>;IFN FTIP
MOVEI A,ILEVEL ;INTENB USED TO BE AFTER ICP
MOVEM A,JOBAPR ; SO A VERY QUICK CLOSE COULD GO UNNOTICED
MOVSI A,INTINP!INTIMS!INTINS
INTENB A, ;ENABLE FOR IMP INPUT INTERRUPTS
PUSHJ P,ICP ;INITIAL CONNECTION PROTOCOL
JRST ERRKIL
INBUF IMP,2
OUTBUF IMP,2
MOVEI A,=8
DPB A,[POINT 6,IBUF+1,11]
DPB A,[POINT 6,OBUF+1,11]
;dcs: 4-12-73
;Some sites won't send allocation for our control out link until we
; send them some for our control in link. We don't do that (in the NCP)
; until the user program does something to suggest input -- so that
; user-specified allocation, if any, will be used. This test for input
; is sufficient to get our NCP to send allocation.
mtape imp,[=8] ;send them allocation for control conn.
jfcl
IFN FTIP,<
PUSHJ P,SAYWHO ;type out name of host we're talking to
>;IFN FTIP
PUSHJ P,GREET ;SEND USER OUR GREETING MESSAGE
MOVEM P,SAVPDP#
REGO: MOVE P,SAVPDP
MOVE A,CIP1
MOVEM A,CIP
; MOVE A,DIP1
; MOVEM A,DIP
; MOVE A,DOP1
; MOVEM A,DOP ;BECOMES CLEAR NEED TO
SETZM CIHUNG ; SAVE DATA IN COMMON
; SETZM DIHUNG ; AND CLEAR WITH BLT'S!
; SETZM DOHUNG
SETZM QUITNG
SETZM DIACTV
SETZM DOACTV
SETZM PRIVS ;PARANOID? ME, PARANOID?
;LOOP SCHEK STATUS
;; MAIN LOOP OF FTPS
;; PROGRAM LOOPS UNTIL XACTV IS INCREASED TO ZERO, THEN GOES
;; INTO INTERRUPT WAIT. INTERRUPT-LEVEL MODULE WILL SET XACTV TO
;; A SMALL NEGATIVE INTEGER, AND MAY ALSO SET SCHEKF
LOOP: CLKINT =30*=60*=60
AOSG SCHEKF ;TIME TO CHECK IMP STATUS?
PUSHJ P,SCHEK ; YES
PUSHJ P,CIDISP ;DISPatch to Control Input handler
; SKIPE DIACTV ;Data In channel ACTiVe?
; PUSHJ P,DIDISP ; YES
; SKIPE DOACTV
; PUSHJ P,DODISP
INTMSK [0]
AOSLE XACTV ;ANYTHING STILL WANTING ATTENTION?
IMSTW [-1] ; NO, ENABLE INTERRUPTS AND WAIT
INTMSK [-1] ;ENABLE INTERRUPTS IN CASE WE SKIPPED
JRST LOOP
SCHEK: MTAPE IMP,STATUS
MOVE A,STATUS+1
OR A,STATUS+2
TLC A,RFC ;these bits should be on (now off)
TLNN A,RFC!CLS ;CONTROL LINK CLOSING?
POPJ P, ; NO, ALL IS OK
IFN VERBOSE,<
OUTSTR [ASCIZ / Control link closed!/]
>;
JRST ERRKIL
STATUS: 2 ↔ 0 ↔ 0
;SAVACX SAVACS GETACS
;; ACCUMULATOR SAVE, RESTORE ROUTINES, ALSO CLOCK TURNING-ON ROUTINE
SAVACX: 0
SAVACS: ;CALL: PUSH P,[XWD 0,<ADDRESS OF 17 WORD BLOCK>]
; JRST SAVACS
; ROUTINE DOES NOT RETURN. THE ARGUMENT
; ON THE STACK IS POPPED OFF, AND THEN A POPJ
; IS PERFORMED.
MOVEM 0,@(P) ;SAVE AC0
MOVE 0,(P)
ADD 0,[XWD 1,16] ;C(0) = 1,,LOC+16
HRRZM 0,SAVACX
SUBI 0,15 ;C(0) = 1,,LOC+1
BLT 0,@SAVACX ;SAVE AC1-16
SUB P,[XWD 1,1] ;DELETE ARGUMENT FROM STACK
POPJ P, ;RETURN UPLEVEL
GETACS: ;CALL: PUSHJ P,GETACS
; XWD 1,<ADDRESS OF 17 WORD BLOCK>
; RETURN HERE ALWAYS
HRLZ 16,@(P) ;C(16) = XWD <ADDR>,0
BLT 16,15 ;RESTORE ACS 0-15
HRRZ 16,@(P)
MOVE 16,16(16) ;RESTORE AC16
JRST CPOPJ1 ;RETURN
;CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL
; DISPATCH ROUTINES
; CI PREFIX MEANS CONTROL INPUT
; DI PREFIX MEANS DATA INPUT
; DO PREFIX MEANS DATA OUTPUT
CIDISP: SKIPE CIHUNG ;IS CI ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST CIREEN ; YES, REENTER CI ROUTINE
EXCH P,CIP
PUSHJ P,CIROUT ; NO, START AT BEGINNING OF CI ROUTINE
EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
SETZM CIHUNG ;INDICATE THAT CI ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
CIREEN: PUSHJ P,GETACS
XWD 1,CIACS
EXCH P,CIP ;RETRIEVE CI PUSHDOWN POINTER
POPJ P, ;AND RETURN WO WAITING CI ROUTINE.
CIWAIT: SETOM CIHUNG ;PUSHJ TO HERE TO MAKE CI ROUTINE WAIT
CIWAIX: EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
PUSH P,[XWD 0,CIACS]
JRST SAVACS ;SAVE CI ACCUMULATORS, RETURN TO MAIN LOOP
CIACS: BLOCK 17 ;STORAGE FOR CI ACCUMULATORS 0-16
CIP: XWD -PDLL,CIPDL ;STORAGE FOR CI ACCUMULATOR 20 WHEN CI
CIP1: XWD -PDLL,CIPDL
; ROUTINE IS ACTIVE, MAIN ACC 17 OTHERWISE
CIHUNG: 0 ;NON ZERO MEANS CI ROUTINE IS WAITING
CIPDL: BLOCK PDLL
repeat 0,<
DIDISP: SKIPE DIHUNG
JRST DIREEN
EXCH P,DIP
PUSHJ P,DIROUT
EXCH P,DIP
SETZM DIHUNG
POPJ P,
DIREEN: PUSHJ P,GETACS
XWD 1,DIACS
EXCH P,DIP
POPJ P,
DIWAIT: SETOM DIHUNG
EXCH P,DIP
PUSH P,[XWD 0,DIACS]
JRST SAVACS
DIACS: BLOCK 17
DIP: XWD -PDLL,DIPDL
DIP1: XWD -PDLL,DIPDL
DIHUNG: 0
DIPDL: BLOCK PDLL
DODISP: SKIPE DOHUNG
JRST DOREEN
EXCH P,DOP
PUSHJ P,DOROUT
EXCH P,DOP
SETZM DOHUNG
POPJ P,
DOREEN: PUSHJ P,GETACS
XWD 1,DOACS
EXCH P,DOP
POPJ P,
DOWAIT: SETOM DOHUNG
EXCH P,DOP
PUSH P,[XWD 0,DOACS]
JRST SAVACS
DOACS: BLOCK 17
DOP: XWD -PDLL,DOPDL
DOP1: XWD -PDLL,DOPDL
DOHUNG: 0
DOPDL: BLOCK PDLL
>;repeat 0
;CIROUT COMDIS BADCOM
;; CI ROUTINE - READ COMMANDS FROM CONTROL LINK, SEND ANSWERS, ETC.
CIROUT: PUSHJ P,GETCOM ;READ COMMAND FROM IMP
POPJ P, ; IT WAS A BUM COMMAND
PUSHJ P,GETIDX ;C(A) ← # OF COMMAND
PUSHJ P,@COMDIS(A)
JRST SXACTV ;4-28-73 make sure all input is read.
DEFINE X(A,B) <IFIDN<B><><0+A;>0+B>; second arg is address if different from name
COMDIS: BADCOM
NAMES
BADCOM: PUSHJ P,FLUSCS
PUSHJ P,GSRCI ;GET PERMISSION TO OUTPUT ON CONTROL CHANNEL
PUSHJ P,IMPST0
ASCIZ /500 No comprendo "/
PUSHJ P,ASCII1
C
PUSHJ P,IMPST0
ASCIZ /"
/
SOS IMPSTF ;RETURN PERMISSION
JRST FLUSCS
;APPE STOR WAITIL GETSET GETSE1 GETSEL C2 GETSEA MLFL STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1
;; APPEND, STOR, MLFL -- RECEIVE A FILE. GETSET, ILDERR, STOMES, WAITIL
repeat 0,<
APPE: SKIPA B,[3] ;APPEND
STOR: MOVEI B,2 ;STORE
PUSHJ P,WAITIL ;WAIT FOR OLD FILENAME, XFERTYPE FREE
MOVEM B,STORTYP# ;SAVE FOR MESSAGE LATER
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
SKIPE DIACTV ;DATA CHANNEL ALREADY IN USE?
JRST STORX0 ; YES
MOVEI B,1
PUSHJ P,GETSET ;SET UP DITYPE, DIBS
JRST ASCERR
PUSHJ P,GFN ;GET FILE NAME
JRST STORX1 ; DIDN'T GET ONE
SETZM EOFMAI
SETOM HOLDIL ;DON'T LET ANYONE ELSE IN
MOVE B,STORTYP
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST ILDERR ; FAILED
MOVEM C,DIACS+C ;PASS ON FILE NAME INFORMATION,
MOVEM D,DIACS+D ; ETC. TO THE
MOVEM E,DIACS+E ; DI ROUTINE
MOVEM F,DIACS+F
SETOM DIACTV ;STARTUP DI ROUTINE
JRST FLUSCS ;FLUSH COMMAND STRING & RETURN
WAITIL: SKIPN HOLDIL# ;WAIT FOR HOLDIL FREE
POPJ P, ; WHICH MEANS WE DON'T NEED ERRFIL ETC ANYMORE
PUSHJ P,CIWAIT
JRST WAITIL
>;repeat 0
;; GETSET SET UP TYPE AND BYTE SIZE FOR TRANSFER
;;CALL: MOVEI B,<0 FOR DO, 1 FOR DI>
;; PUSHJ P,GETSET
;; ERROR RETURN - TYPE A AND NOT BYTE 8
;; GETSEA FAKE TYPE A BYTE 8 FOR MAIL/MLFL, NO SKIP RETURN
GETSET: MOVE A,RTYPE ;GET TYPE FROM USER
CAIN A,3 ;LOCAL PRINT
MOVEI A,0 ; IS REALLY ASCII
;;; JUMPE A,GETSEA ;ASCII USES BYTE 8 REGARDLESS
MOVE T,RBS ;ELSE WE GOBBLE REAL BYTE SIZE
CAIE T,=8
JUMPE A,CPOPJ
AOS (P)
CAIE A,1 ;IMAGE?
JRST GETSEL ;NO, LOCAL BYTE
CAIE T,=8 ;IMAGE, MAYBE CONVERT TO EASIER LOCAL BYTE
CAIN T,=32 ; BUT NOT FOR THESE BYTE SIZES
JRST GETSEL
SKIPA A,C2 ;ANY OTHER BYTE SIZE OK FOR LOCAL TYPE
GETSE1: MOVEI T,=8 ;CONSTANT BYTE SIZE FOR ASCII
GETSEL: MOVEM T,DOBS(B) ;SAVE BYTE SIZE
HRRZM A,DOTYPE(B) ; AND TYPE FOR THIS TRANSFER
C2: POPJ P,2
GETSEA: MOVEI A,0 ;ASCII TYPE
JRST GETSE1
repeat 0,<
MLFL: SKIPE DIACTV ;DON'T DO IT IF THINGS ARE HAPPENING
JRST STORX3
MOVEI A,[ASCIZ ⊗MAIL⊗]
MOVEM A,NTMLCM
TRO FLG,.MAIL ;NEEDED TO ALLOW FORWARDING
SKIPGE XRSQSW ; If hacking XRCP,
PUSHJ P,XRSRST ; always reset buffer here.
PUSHJ P,MLNMST ;GET A MESSAGE FILE NAME
JRST [ SKIPN XRSQSW ; Bad name... hacking XRCP?
JRST NOUSER ; Nope, really failed.
JUMPG C,NOUSER ; Also fail if any name was spec'd.
SKIPL XRSQSW
SKIPE XRFOBP
CAIA
JRST NOUSER ; Recip-first and no recips.
SKIPGE XRSQSW ; Skip if R-first style.
AOS XRBPTR ; Win, ensure we'll start storing
JRST MLFL20] ; msg text.
PUSHJ P,VALID ;LOOK UP LOSER IN MFD
JRST NOMAIL ;NO SUCH LOSER
SETZM XRFOBP ; Reset XRCP recipient list.
MLFL20: MOVE A,XRFOBP
MOVEM A,XRFHBP ; Flag XRCP-R mode for header
SETZM XRFOBP ; In case we die before mailing.
PUSHJ P,FLUSCS ;PREVENT SPURIOUS 500 ERROR
;; PUSH P,RTYPE ;MLFL IS ALWAYS TYPE ASCII REGARDLESS
;; SETZM RTYPE
MOVEI B,1 ;FLAG DI
PUSHJ P,GETSEA ;SET UP TYPE AND BYTE SIZE
;; POP P,RTYPE
PUSHJ P,WAITIL
MOVEI B,6 ;SPECIAL MAIL STORE TYPE
MOVEM B,STORTYP
SETOM EOFMAI ;FLAG FOR DIEOF
TRZ FLG,17 ;FLAG MLFL FOR DIEOML -- NOT MAIL OR FRIENDS
TLZ FLG,MFRDUN!MSJDUN ;"FROM" & "SUBJECT" LINES NOT FOUND YET
TLO FLG,(MEOFBT) ;FLAGS MAIL FOR DIEOF
SKIPGE XRBPTR
JRST MLFL40 ; Skip output file stuff if saving msg text.
PUSHJ P,SETMFL
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST ILDERR ; FAILED
TLO FLG,(MEOFBT) ;FLAGS MAIL FOR DIEOF (ILDDEV MUNGS)
MOVEM C,DIACS+C ;PASS ON FILE NAME INFORMATION,
MOVEM D,DIACS+D ; ETC. TO THE
MOVEM E,DIACS+E ; DI ROUTINE
MOVEM F,DIACS+F
OUT FIMP, ;LEAVE AN EMPTY RECORD FOR LATER
MOVEI A,40
PUSHJ P,WRTCHR ;WRITE SOMETHING INNOCUOUS
SETZM FIBUF+2 ;MAKE SURE WE DO ANOTHER OUT
PUSHJ P,RCVD ;insert line saying when Received and from where
MLFL40: SETOM DIACTV ;STARTUP DI ROUTINE
POPJ P,
STORX3:
STORX0: PUSHJ P,IMPSTR
ASCIZ /505 You are already STORing!
/
STOR1: JRST FLUSCS ;FLUSH REST OF COMMAND STRING
RETRX1:
STORX1: PUSHJ P,IMPSTR
ASCIZ /501 Pathname unparsable
/
JRST FLUSCS
>;repeat 0
ILDERR: PUSHJ P,GSRCI ;INTERPRET ILDDEV ERROR FOR LOSER
MOVE F,ERRTYP ;THIS IS THE TYPE OF ERROR
CAIGE F,3 ; UNLESS ERROR WAS FROM LOOKUP ETC
JRST ILDER1 ; IN WHICH CASE WE NEED ERROR CODE
HRRZ C,ILDD+1 ; FROM LOOKUP (ETC) BLOCK
SKIPA D,ERRNM1(C) ;THIS IS THE RESPONSE CODE IN THAT CASE
ILDER1: MOVE D,ERRNUM(F) ;RESPONSE CODE FOR NON-LOOKUP-ETC ERROR
MOVE E,[POINT 7,D]
PUSHJ P,ASCIIE ;PUT OUT CODE
PUSHJ P,STOMES ;PUT OUT TYPE OF OPERATION AND FILE
HRRZ C,ILDD+1 ;RESTORING CLOBBERED AC
MOVE E,[POINT 7,[ASCIZ / failed, /]]
PUSHJ P,ASCIIE
CAIGE F,3 ;DISPATCH ON ERROR AGAIN
SKIPA E,ERRTXT(F)
MOVE E,ERRTX1(C)
PUSHJ P,ASCIIE
MOVE E,[POINT 7,[ASCIZ /
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
JRST FLUSCS
STOMES: MOVE D,STORTYP# ;FIND OUT WHAT HE WAS DOING
CAIN D,30
MOVEI D,4 ;FILL A BIG HOLE
MOVE E,TYPNAM-1(D) ;GET PTR TO OPERATION NAME
PUSHJ P,ASCIIE
JRST @TYPDSP-1(D) ;PUT OUT FILE NAME OR WHATEVER
REPEAT 0,<
ERRNUM: ASCII /453 / ;0 - OPEN FAILED
ASCII /450 / ;1 - UFD LOOKUP FAILED
ASCII /451 / ;2 - ACCESS PROHIBITED
ERRNM1: ASCII /450 / ;0 - NO SUCH FILE
ASCII /450 / ;1 - NO SUCH PPN (CAN'T HAPPEN)
ASCII /451 / ;2 - PROTECTION VIOLATION (CAN'T)
ASCII /453 / ;3 - FILE BUSY
ASCII /450 / ;4 - ALREADY EXISTS (RENAME)
ASCII /506 / ;5 - NO FILE OPEN (CAN'T)
ASCII /506 / ;6 - DIFFERENT FILENAME (R/A, CAN'T)
ASCII /506 / ;7 - CAN'T
ASCII /453 / ;10 - BAD RTVL
ASCII /453 / ;11 - BAD RTVL
ASCII /453 / ;12 - DISK FULL
>;REPEAT 0
ERRNUM: ASCII /451 / ;0 - OPEN FAILED
ASCII /451 / ;1 - UFD LOOKUP FAILED
ASCII /451 / ;2 - ACCESS PROHIBITED
ERRNM1: ASCII /451 / ;0 - NO SUCH FILE
ASCII /451 / ;1 - NO SUCH PPN (CAN'T HAPPEN)
ASCII /451 / ;2 - PROTECTION VIOLATION (CAN'T)
ASCII /451 / ;3 - FILE BUSY
ASCII /451 / ;4 - ALREADY EXISTS (RENAME)
ASCII /451 / ;5 - NO FILE OPEN (CAN'T)
ASCII /451 / ;6 - DIFFERENT FILENAME (R/A, CAN'T)
ASCII /451 / ;7 - CAN'T
ASCII /451 / ;10 - BAD RTVL
ASCII /451 / ;11 - BAD RTVL
ASCII /452 / ;12 - DISK FULL
TYPNAM: POINT 7,[ASCIZ /Retrieve of /]
POINT 7,[ASCIZ /Store of /]
POINT 7,[ASCIZ /Append to /]
POINT 7,[ASCIZ /Rename of /] ;REALLY STORTYP 30
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Mail scratch file open/]
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Delete of /]
ERRTXT: POINT 7,[ASCIZ /can't initialize local device/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
ERRTX1: POINT 7,[ASCIZ /no such file/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
POINT 7,[ASCIZ /file busy/]
POINT 7,[ASCIZ /new filename already exists/]
POINT 7,[ASCIZ /impossible system error (5)/]
POINT 7,[ASCIZ /impossible system error (6)/]
POINT 7,[ASCIZ /impossible system error (7)/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /disk is full/]
TYPDSP: ERRFN ;RETR, WHOLE FILESPEC
ERRFN ;STOR
ERRFN ;APPE
ERRFN ;RENAME
ERRPP ;STAT, FN AS PPN
CPOPJ ;MAIL
ERRFN ;USED FOR START MSG FOR LIST, NLST
ERRFN ;DELE
ERRPP: MOVE D,ERRFIL ;DO FILENAME AS PPN
ERRPP1: TLNN D,-1 ;IF MAIL, MAYBE ONLY PRG
JRST ERRPP2
MOVEI A,"["
PUSHJ P,PUTCH1
HLLZ B,D
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,PUTCH1
ERRPP2: HRLZ B,D
JUMPN B,.+2
MOVEI B,'* ' ;FOR MAIL
PUSHJ P,SIXWRT
TLNN D,-1
POPJ P,
MOVEI A,"]"
JRST PUTCH1
ERRMF: MOVE B,RMLF
PUSHJ P,SIXWRT
SKIPN B,RMLE
JRST ERRMF1
MOVEI A,"."
PUSHJ P,PUTCH1
PUSHJ P,SIXWRT
ERRMF1: MOVE D,RMLD
JRST ERRPP1
ERRFN: MOVE B,ERRDEV
PUSHJ P,SIXWRT
MOVEI A,":"
PUSHJ P,PUTCH1
MOVE B,ERRFIL
PUSHJ P,SIXWRT
SKIPN B,ERREXT
JRST ERRFN1
MOVEI A,"."
PUSHJ P,PUTCH1
PUSHJ P,SIXWRT
ERRFN1: MOVE D,ERRPPN
JRST ERRPP1
;RNFR DELE GCRNTO RENFIL RNMOK RELDMP RNTO BADTO BDTONM BADDRN ALLO
repeat 0,<
;; RNFR (RNTO), DELE ROUTINE : ZAP LOCAL FILES
RNFR: SKIPA B,[30] ;RENAME
DELE: MOVEI B,10 ;DELETE
PUSHJ P,WAITIL
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
MOVEM B,STORTYP ;SAVE WHICH
SKIPE DOACTV
JRST RETRX0
PUSHJ P,GFN ;FIRST OR ONLY FILE
JRST RETRX1
MOVEI B,21 ;20 BIT CHECKS WRITE ACCESS EVEN THO READ OP
PUSHJ P,ILDDEV ;DO THE LOOKUP
JRST ILDERR ; COULDN'T FIND
SETZB E,F
MOVE B,STORTYP ;NOW MUST EITHER DELETE OR RENAME
TRNN B,20 ;RENAME?
JRST RENFIL ;NO, DELETE
PUSHJ P,FLUSCS ;TERMINATE THAT LINE
PUSHJ P,IMPSTR ;REPORT PARTIAL SUCCESS
ASCIZ /200 RNFR OK, Please issue RNTO
/
GCRNTO: PUSHJ P,GETCOM ;NOW GET THE NEXT
JRST RELDMP ;BAD COMMAND, COULDN'T BE RNTO
PUSHJ P,GETIDX
TRNE A,777776 ;NEXT COMMAND MUST BE RNTO, WHOSE
JRST BADTO ; COMMAND INDEX IS 1 (LH JUNK)
PUSHJ P,GFN
JRST BDTONM ;BAD NAME AFTER RNTO
MOVEI B,10 ;ONE MORE TIME
RENFIL: PUSHJ P,ILDDEV ;DELETE (RENAME) THE FILE
JRST BADDRN ; COULDN'T DO THAT
JUMPN F,RNMOK
PUSHJ P,IMPSTR ;OK RESPONSE
ASCIZ /254 File deleted
/
JRST RELDMP
RNMOK: PUSHJ P,IMPSTR ;OK RESPONSE
ASCIZ /253 File renamed
/
RELDMP: RELEASE DIMP, ;CLOSE DOWN
JRST FLUSCS
RNTO:
BADTO: PUSHJ P,IMPSTR
ASCIZ /505 Must have RNTO after RNFR
/
JRST RELDMP
BDTONM: PUSHJ P,IMPSTR
ASCIZ /501 Pathname for rename unparseable
/
JRST RELDMP
BADDRN: RELEAS DIMP,
JRST ILDERR
ALLO: PUSHJ P,IMPSTR
ASCIZ/206 It's ALLOver, don't shed a tear for me
/
JRST FLUSCS
>;repeat 0
;⊗ HELO HELOLP NOOP NOFROM RCPT RCPTML RELDUN RCPTCL RCPTX SYNERR UNKHST BADHMS BADHM2 WHOIAM NORLAY XSEN XSEM XMAS MAIL MAILCM MAILER GETFRM GETFRL GETFRS GETFRQ GETFNQ GETFRE GETFRX OK250 NODEST DATA NMAIL MAILIN NODOT EOMAIL MAIL91 SETMFL SETMFR RMDLK RMDAOS RMDFIL WRHDR WHDFRB WSCRLF WHDFRM RCDCR WRTSSP WRTSS1 WRTSTR WRTST1 WRTST2 wrtsix wrlp wrsoj SWRTCH WRTCHR CORERR IERR4 HELP NOMAIL NOUSER SYNER2 SENERR NOPPNM RCVD DAYLIT MAISTR MAIST2 MAIDEC MAI2DG
HELO: MOVE B,[POINT 7,XRFBUF] ;byte ptr for copying name
MOVEM B,XRFBBP ;save for GETCHR
SETZM XRFBZZ ;clear any previous overflow
HELOLP: PUSHJ P,GETCHR
CAIE A,12
JRST HELOLP
MOVEI A,0
IDPB A,XRFBBP ;terminate string with null
SETZM XRFBBP ;stop copying
MOVE A,[XRFBUF,,SNDNAM]
BLT A,SNDNAM-1+1+MAXPTH/5 ;copy name to where we want it
PUSHJ P,IMPSTR
ASCIZ/250 /
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPCR ;output crlf
POPJ P,
NOOP: REPMES (250 No-op acknowledged.)
NOFROM: REPMES (503 You forgot to send a MAIL command first.)
RCPT: SKIPN GOTFRM
JRST NOFROM ;no MAIL cmd yet
MOVE B,[POINT 7,XXBUF] ;byte ptr for copying line
MOVEM B,XXBBP ;save for GETCHR
SETZM XXBZZ ;clear any previous overflow
PUSHJ P,GETDST ;Get a destination name
JRST RELDUN ;JRST NORLAY ;relaying requested
JRST SYNERR ;syntax error or bad host name
JRST NOUSER ;ERROR
PUSHJ P,VALID ;LOOK UP LOSER IN MFD
JRST NOMAIL ;NO SUCH LOSER
SETZM XXBBP ;quit collecting recipient line
ifn 1,<
TRNE FLG,.MAIL!.XMAS!.XSEM ;skip if cmd is just SEND
JRST RCPTML ;not just sending, but possibly mailing
PUSHJ P,LOGGED ;see if this user is logged in
JRST SENERR ;nope
RCPTML:
>;ifn 1
RELDUN: MOVEI A,","
AOSE FSTDST ;skip if this is first destination
PUSHJ P,WRTCHR ; Separate recipients in .FTP file
MOVE B,[POINT 7,XRFBUF] ; set up BPT to copy valid recipient name
RCPTCL: ILDB A,B
JUMPE A,RCPTX
PUSHJ P,WRTCHR ;write char to .FTP file
JRST RCPTCL
RCPTX: REPMES (250 Recipient name accepted.)
SYNERR: SKIPGE SYNCOD ;skip unless really is bad host name
JRST UNKHST ;bad host name
PUSHJ P,IMPSTR
ASCIZ/500 Syntax error #/
MOVE A,SYNCOD ;get error code
PUSHJ P,IMPOCT ;output octal number from A
PUSHJ P,IMPSTR
ASCIZ/ in recipient specification: "RCPT /
JRST SYNER2 ;go copy recipient line into reply
UNKHST: MOVN E,SYNCOD ;get postive bad-host code
HRRZ E,BADHMS-1(E) ;get ptr to beginning of reply
PUSHJ P,IMPSTN ;output it
MOVEI E,DSTHNM ;ptr to losing host name string
PUSHJ P,IMPSTN ;output to foreign mailer
MOVN E,SYNCOD ;positive code again
XCT BADHM2-1(E) ;special action for this error
PUSHJ P,IMPSTR
ASCIZ/", in "RCPT /
JRST SYNER2 ;go copy recipient line into reply
;table of bad-host-name messages, selected by negative value in SYNCOD from GETDST
BADHMS: [ASCIZ/550 Unknown host (mail relay dest): "/] ;-1
[ASCIZ/550 I'm not host "/] ;-2
;table parallel to above, XCT'd
BADHM2: JFCL ;nothing special
PUSHJ P,WHOIAM ;say who I am
WHOIAM: MOVEI E,[ASCIZ/", I'm "/]
PUSHJ P,IMPSTN ;output it
MOVEI E,OURSTR ;ptr to our host name
JRST IMPSTN ;output it to foreign mailer
repeat 0,<
NORLAY: SETZM XXBBP ;quit collecting recipient line
REPMES (550 Mail relaying not yet implemented.)
>;repeat 0
;;MAIL -- ACCEPT NETWORK MAIL
XSEN: MOVEI A,[ASCIZ ⊗SEND/NOMAIL⊗]
MOVEM A,NTMLCM#
MOVEI A,.XSEN ;SEND/N
JRST MAILCM
XSEM: MOVEI A,[ASCIZ ⊗SEND/YESMAI⊗]
MOVEM A,NTMLCM
MOVEI A,.XSEM ;SEND/Y
JRST MAILCM
XMAS: MOVEI A,[ASCIZ ⊗SEND/MAIL⊗]
MOVEM A,NTMLCM
MOVEI A,.XMAS ;SEND/M
JRST MAILCM
MAIL: MOVEI A,[ASCIZ ⊗MAIL⊗]
MOVEM A,NTMLCM
MOVEI A,.MAIL ;MAIL
MAILCM: SETZM GOTFRM
RELEAS FIMP,3 ;flush any output file we were writing
TRZ FLG,17 ;TURN OFF FLG BITS FOR COMMAND
IORI FLG,(A) ;SET WHICH COMMAND WE'RE DOING
MOVEI B,6 ;CODE FOR MAIL STORE
MOVEM B,STORTYPE
SETOM EOFMAI# ;SET FLAG FOR DIEOF
SETOM FSTDST# ;flag no dests seen yet
PUSHJ P,SETMFL ;SET MAIL FILE NAME
PUSHJ P,ILDDEV ;OPEN FILE FOR OUTPUT
JRST ILDERR
TLO FLG,(MEOFBT) ;FLAGS MAIL FOR DIEOF
PUSHJ P,GETFRM ;get reverse path into REVPTH
JRST MAILER ;bad form, error reply already made
PUSHJ P,WRHDR ;write .FTP file header (mail cmd)
SETOM GOTFRM# ;flag MAIL cmd seen
POPJ P,
;Here on some syntax error in the MAIL From: command.
MAILER: RELEASE FIMP,3 ;flush output file
SETZM REVPTH ;no valid reverse path now
POPJ P,
;Get the sender field out of the MAIL From: line (the part in brackets).
;Skips on success. On syntax error, send error reply and take direct return.
GETFRM: PUSHJ P,SKPSPG ;START SCANNING HIS INPUT
MOVE B,[POINT 7,[ASCIZ/from:/]]
PUSHJ P,CHKSTR ;make sure starts with "from:"
JRST [REPMES (501 "From:" not found in command.)]
PUSHJ P,SKPSGL ;skip spaces again
CAIE A,"<" ;> ;path must start with left bracket
JRST [REPMES (501 "From:" not followed by "<".)] ;> match bracket
TLZ FLG,QUOTEF ;no quoting in progress yet
SETZM REVPTH ;clear any previous reverse path
SETOM COLONS ;count colons to avoid a particular bad format
MOVEI C,MAXPTH ;max length string we can store
SKIPA B,[POINT 7,REVPTH] ;byte ptr for storing reverse path
GETFRL: IDPB A,B ;store new char in buffer
GETFRS: PUSHJ P,GETCHR ;get a char from the command
CAIN A,42 ;double quote?
JRST [ TLC FLG,QUOTEF ;set or clear quoting flag
JRST GETFNQ] ;on to next char
TLNE FLG,QUOTEF ;skip unless quoting
JRST GETFRQ ;quoting, allow right bracket and spaces
CAIN A,":" ;count relay-host ending characters (colons)
AOSG COLONS ;skip if already had seen an earlier colon
CAIA
JRST [REPMES (501 Reverse-path has more than one colon.)]
CAIN A,76 ;right bracket?
JRST GETFRX ;yes, end of sender field--end of line next
CAIE A,11
CAIN A," "
JRST GETFRS ;ignore spaces and tabs that aren't quoted
GETFRQ: CAIE A,15 ;(match < below)
CAIN A,12 ;check for end of line without right bracket
JRST [REPMES(501 Reverse-path doesn't end with ">".)]
CAIE A,"\" ;quoting char?
JRST GETFNQ ;no
SOJLE C,GETFRE ;yes, jump if path too long now
IDPB A,B ;stuff quoter into string
PUSHJ P,GETCHR ;get quoted char, for stuffing into string
GETFNQ: SOJG C,GETFRL ;loop unless string too long
GETFRE: SETZM REVPTH
REPMES (501 Reverse-path too long.)
;Here when have seen right bracket ending reverse path -- should be crlf next.
GETFRX: MOVEI A,0 ;terminate sender string
IDPB A,B ; with null (don't keep brackets)
PUSHJ P,SKPSPG ;skip following spaces, get CR
CAIE A,15 ;command line end with CR?
JRST [REPMES (501 Extraneous text after "From:<...>" and before carriage return.)]
PUSHJ P,GETCHR ;get char after CR
CAIN A,12 ;LF?
JRST OK250 ;yup, all done, don't store CRLF
REPMES (501 Linefeed missing after carriage return ending command.)
OK250: PUSHJ P,IMPSTR
ASCIZ/250 OK
/
JRST CPOPJ1
NODEST: RELEAS FIMP,3
SETZM GOTFRM
REPMES (503 You forgot to tell me whom to mail to -- use RCPT before DATA.)
DATA: SKIPN GOTFRM ;any MAIL cmd seen?
JRST NOFROM ;nope, lose
SKIPGE FSTDST ;skip if any dests seen
JRST NODEST ;no dests
PUSHJ P,WSCRLF ;close first page of .FTP file
PUSHJ P,RCVD ;insert line saying when Received and from where
SETZM GOTFRM ;no more recipients allowed
PUSHJ P,FLUSCS ;BH 7/31/80 So MAIL @FOO[A,B] reads past crlf
MOVEI B,1 ;DI
PUSHJ P,GETSEA ;SET TYPE AND BYTE SIZE
NMAIL: PUSH P,E
PUSHJ P,IMPSTR
ASCIZ /354 What's shakin'? End text with <crlf>.<crlf>
/
POP P,E
; here at every new mail line
MAILIN: PUSHJ P,RGETCH ;CHARACTER OF MAIL
CAIE A,"." ;".", MAY BE END OF MSG
JRST NODOT
PUSHJ P,RGETCH ;SEE
CAIN A,15 ;if not end of mail, we flush leading dot anyway
JRST EOMAIL ;END OF MAIL
;here with each new char
NODOT: PUSHJ P,SWRTCH
CAIN A,12 ;END OF LINE?
JRST MAILIN
PUSHJ P,RGETCH
JRST NODOT
EOMAIL: TLZA FLG,LFSEEN
MAIL91: TLZA FLG,LFSEEN
PUSHJ P,RGETCH ;GET THE LF
RELEASE FIMP,
PUSHJ P,IMPSTR
ASCIZ /250 Thanks for the blurb
/
MOVEI E,RMDWAK
WAKEME E, ;wake up remind phantom to deliver the mail
JFCL
SKIPN QUITNG ;IF TRIED TO QUIT, TRY
POPJ P, ; AGAIN (MULTIPLE-SUICIDE MODE)
JRST BYE1
SETMFL: MOVEM F,RMLF#
MOVEM E,RMLE#
MOVEM D,RMLD#
SETMFR: ACCTIM A, ;HIGHLY MNEMONIC FILE NAME
DPB A,[POINT 12,A,29] ;SHIFT RH BY 6 BITS
MOVEM A,RMDFIL
PJOB A,
DPB A,[POINT 6,RMDFIL,35]
INIT UFDC,217
('DSK')
0
JRST QUIT
RMDLK: MOVE A,RMDSYS
MOVEM A,RMDFIL+3
LOOKUP UFDC,RMDFIL
SKIPA A,RMDFIL+1
JRST RMDAOS
TRNE A,-1
JRST RMDAOS
MOVE F,RMDFIL
HLLZ E,RMDFIL+1
MOVE D,RMDSYS
MOVSI C,'DSK'
RELEAS UFDC,
POPJ P,
RMDAOS: MOVEI A,100
SUBM A,RMDFIL ;USED TO BE AOS, BUT SOS IS SAFER
;NOT REALLY SOS DUE TO JOB BUT THIS
;PROGRAM IS SUCH A PIECE OF SHIT ALREADY
;ANOTHER TURD WON'T HURT
JRST RMDLK
RMDFIL: 0
'FTP ' ;extension to use to write cmd file for MAIL
0
0 ;PPN stuffed in here from cell called RMDSYS
WRHDR: MOVE B,[PUSHJ P,WRTCHR]
MOVEM B,OUTINSTR
MOVE F,RMLF
MOVE E,RMLE
MOVE D,RMLD
MOVE B,NTMLCM
PUSHJ P,WRTSTR ;COMMAND AND SWITCH
MOVEI B,[ASCIZ ⊗/FROM↓⊗]
PUSHJ P,WRTSTR
SKIPE REVPTH ;DID HE IDENTIFY HIMSELF?
JRST WHDFRM ;YES, USE HIS OWN ID IN HEADER
repeat 0,< ;now we just leave an empty /FROM↓↓ switch for MAIL to see
MOVEI B,[ASCIZ / host /]
PUSHJ P,WRTSTR
MOVEI B,HSTSTR
PUSHJ P,WRTSTR
>;repeat 0
WHDFRB: MOVEI B,[ASCIZ /↓ /]
PUSHJ P,WRTSTR
POPJ P,
WSCRLF: MOVEI B,RCDCR
PUSHJ P,WRTSTR ; <CRLF>
MOVEI A,14
PUSHJ P,WRTCHR
POPJ P,
WHDFRM: MOVEI B,REVPTH
PUSHJ P,WRTSSP
JRST WHDFRB
RCDCR: ASCIZ /
/
WRTSSP: HRLI B,(<POINT 7,0>)
WRTSS1: ILDB A,B
CAIE A," " ;DISCARD LEADING SPACES AND TABS
CAIN A,11 ; IN NETWORK FROM: AND SUBJECT: LINES
JRST WRTSS1
JRST WRTST2
WRTSTR: HRLI B,(<POINT 7,0>)
WRTST1: ILDB A,B
WRTST2: JUMPE A,CPOPJ
XCT OUTINSTR
JRST WRTST1
wrtsix: movei c,6
wrlp: movei a,
lshc a,6
jumpe a,wrsoj
addi a,40
pushj p,wrtchr
jumpe t,wrsoj
caie c,4
jrst wrsoj
movei a,(t)
pushj p,wrtchr
wrsoj: sojg c,wrlp
popj p,
SWRTCH:
WRTCHR: SOSG FIBUF+2
OUT FIMP,
CAIA
JRST IERR4
IDPB A,FIBUF+1
POPJ P,
CORERR: POP P,(P)
PUSHJ P,IMPSTR
ASCIZ /452 Can't get core for message, aborting.
/
POPJ P,
IERR4: PUSHJ P,IMPSTR
ASCIZ /451 Local file system error, mail aborted
/
JRST ERRKIL
HELP: PUSHJ P,IMPSTR
ASCIZ ⊗214-Welcome to sunny California!
214-
214-Implemented Commands: HELO,MAIL,SEND,SOML,SAML,RCPT,DATA,NOOP,RSET,QUIT,HELP.
214 Report problems to Bug-SMTP @ ⊗
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPCR ;output crlf
JRST FLUSCS
NOMAIL: MOVE T1,MLDEST
TLNE T1,-1
JRST NOPPNM
NOUSER: PUSHJ P,IMPSTR
ASCIZ /550 Unrecognized MAIL recipient: "RCPT /
SYNER2: PUSHJ P,FLUSCS ;copy rest of command line to return string
MOVEI E,0
IDPB E,XXBBP ;terminate recipient line's string
ifn verbose,<
outstr xxbuf
>;ifn verbose
MOVE E,[POINT 7,XXBUF]
PUSHJ P,ASCIIE ;copy recipient line into reply
PUSHJ P,IMPSTR ;put out ending quote and crlf
ASCIZ /"
/
SETZM XXBBP ;quit collecting recipient line
SETZM XRFBBP ; No longer copying name.
POPJ P,
SENERR: PUSHJ P,IMPSTR
ASCIZ /450 User not logged in.
/
SETZM XRFBBP ; No longer copying name.
JRST FLUSCS
NOPPNM: PUSHJ P,IMPSTR
ASCIZ /550 Cannot mail to PPNs--use programmer name.
/
SETZM XXBBP ;quit collecting recipient line
SETZM XRFBBP ; No longer copying name.
JRST FLUSCS
;insert line saying when Received and from where, e.g.:
;Received: from CMU-CS-C by SU-AI with TCP/SMTP; 20 Jan 83 11:42:41 PST
;preserves all ACs but A.
RCVD: PUSH P,C
PUSH P,B
MOVEI C,[ASCIZ/Received: from /]
PUSHJ P,MAISTR
MOVEI C,HSTSTR ;ptr to host name
PUSHJ P,MAISTR ;print foreign host's name (our version)
;; MOVEI C,DOMARP ;get ptr to domain string (.ARPA)
;; PUSHJ P,MAISTR ;print it too
MOVEI C,[ASCIZ/ by /]
PUSHJ P,MAISTR
;; MOVE C,WAITST ;get waits site number
;; MOVE C,WATHST(C) ;get ptr to host name string
MOVEI C,OURSTR ;get ptr to our host name string
PUSHJ P,MAISTR ;print our host name
;; MOVEI C,DOMARP ;get ptr to domain string (.ARPA)
;; PUSHJ P,MAISTR ;print it too
MOVEI C,[ASCIZ $ with TCP; $]
PUSHJ P,MAISTR
ACCTIM A, ;get current date,,time in secs
PUSH P,A ;save time
HLRZ A,A ;date
IDIVI A,=31 ;day of month-1 to B
PUSH P,A
MOVEI A,1(B) ;day of month
PUSHJ P,MAIDEC ;print day of month
MOVEI A," "
PUSHJ P,SWRTCH
POP P,A
IDIVI A,=12 ;month-1 to B, year-=64 to A
PUSH P,A
MOVE B,@MONTAB(B) ;name of month
AND B,[BYTE (7)177,177,177] ;shorten name of month to three chars
MOVEI C,B
PUSHJ P,MAISTR ;print month name
MOVEI A," "
PUSHJ P,SWRTCH
POP P,A
ADDI A,=64
PUSHJ P,MAIDEC ;print year in two digits
MOVEI C,[ASCIZ/ /]
PUSHJ P,MAISTR
POP P,A ;time in secs
MOVEI A,(A) ;flush date from LH
IDIVI A,=60*=60 ;hours to A, secs to B
PUSH P,B
PUSHJ P,MAI2DG ;print hours as 2 digits
MOVEI A,":"
PUSHJ P,SWRTCH
POP P,A
IDIVI A,=60 ;mins to A, secs to B
PUSH P,B
PUSHJ P,MAI2DG ;print mins as 2 digits
MOVEI A,":"
PUSHJ P,SWRTCH
POP P,A
PUSHJ P,MAI2DG ;print secs as 2 digits
DAYLIT←←261 ;LOWCORE POINTER TO NONZERO IF DAYLIGHT SAVINGS TIME
MOVEI B,DAYLIT ;FIND OUT IF DAYLIGHT SAVINGS
PEEK B, ;get ptr to cell
PEEK B, ;get flag from cell
MOVEI C,[ASCIZ/ PDT
/]
SKIPN B ;skip if daylight savings
MOVEI C,[ASCIZ/ PST
/]
PUSHJ P,MAISTR ;print time zone and CRLF
POP P,B
POP P,C
POPJ P,
MAISTR: HRLI C,440700 ;make byte ptr
MAIST2: ILDB A,C
JUMPE A,CPOPJ
PUSHJ P,SWRTCH ;String to .FTP file
JRST MAIST2
MAIDEC: IDIVI A,=10 ;output decimal number to .FTP file
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,MAIDEC
HLRZ A,(P)
ADDI A,"0"
JRST SWRTCH
MAI2DG: CAIL A,=10
JRST MAIDEC ;number already has two (or more) digits
PUSH P,A
MOVEI A,"0"
PUSHJ P,SWRTCH ;print leading zero
POP P,A
ADDI A,"0"
JRST SWRTCH ;print second digit
;SEND LOGGED LOGGE1 LOGTST JBLP JBNXT SENDER JUSTEL MSPG MSNFR MSNSJ SENTTY DPBSTR DPBNAM MSBUFR
;This code is not used!! Except LOGGED and LOGTST.
repeat 0,<
SEND: PUSHJ P,LOGTST
PUSHJ P,SENDER
POPJ P,
>;repeat 0
LOGGED: PUSH P,C
PUSH P,D
PUSH P,F
PUSHJ P,LOGTST
JRST LOGGE1
POP P,F
POP P,D
POP P,C
POPJ P,
LOGGE1: POP P,(P)
POP P,F
POP P,D
POP P,C
JRST CPOPJ1
LOGTST: MOVSI A,377777 ;NOTIFY MAIL RECIPIENT IF LOGGED IN
SKIPE MLDEST ;FORGET THIS IF MAIL TO :FILE
SETPR2 A,
JRST CPOPJ1
MOVE T,400222 ;MAX JOB NUMBER
JBLP: MOVE C,400210 ;JBTSTS
ADDI C,400000(T)
MOVE C,(C)
TLNN C,40000
JRST JBNXT ;NO SUCH JOB
MOVE A,400236 ;JBTLIN
ADDI A,400000(T)
MOVE A,(A)
MOVE D,A
AOJE D,JBNXT ;DETACHED
TLNE A,4000 ;PTY BIT
TLNE A,1000 ;ARPA BIT
JRST .+2
JRST JBNXT
MOVEI B,(A)
MOVE F,400211 ;PRJPRG
ADDI F,400000(T)
MOVE F,(F) ;GET JOB'S PPN
MOVE D,MLDEST
TRNE D,-1
TLZA D,-1
HLLZS F
TLNN D,-1 ;MASK OUT WILD FIELD
HRRZS F
CAME F,D
JRST JBNXT
XCT @(P)
JBNXT: SOJG T,JBLP ;LOOK FOR MORE DESTS
JRST CPOPJ1
repeat 0,<
SENDER: TRNN FLG,16 ;SENDING?
JRST JUSTEL ;NO, JUST TELL HIM ABOUT THE MAIL
MOVEI C,[ASCIZ /;; Network message:
/]
MOVEI D,B
TTYMES D,
JFCL
MOVE C,JOBFF ;YES, HERE IS THE MESSAGE
JRST SENTTY
JUSTEL: MOVE A,[POINT 7,MSBUFR] ;B HAS DEST DEVICE
MOVEI C,[ASCIZ /;; →→→ Network mail for /]
PUSHJ P,DPBSTR ;BUILD UP MESSAGE
HLLZ C,MLDEST
JUMPE C,MSPG
PUSHJ P,DPBNAM
MOVEI C,","
IDPB C,A
MSPG: HRLZ C,MLDEST
JUMPN C,.+2
HRLZI C,'* '
PUSHJ P,DPBNAM
IFN FTFRM,<
TLNN FLG,MFRDUN ;IF "FROM" LINE FOUND,
JRST MSNFR ; WE WILL INCLUDE IT HERE
>;IFN FTFRM
IFE FTFRM,<
SKIPN REVPTH ;DID HE IDENTIFY HIMSELF?
JRST WHDFRM ;YES, USE HIS OWN ID IN HEADER
>;IFE FTFRM
MOVEI C,[ASCIZ / from /]
PUSHJ P,DPBSTR
MOVEI C,REVPTH
PUSHJ P,DPBSTR
MSNFR:
IFN FTMSJ,<
TLNN FLG,MSJDUN ;IF "SUBJECT" LINE FOUND,
JRST MSNSJ ; WE WILL INCLUDE IT HERE
MOVEI C,11
IDPB C,A
MOVEI C,MSJBUF
PUSHJ P,DPBSTR
>;IFN FTMSJ
MSNSJ: MOVEI C,[ASCIZ / ←←←
/]
PUSHJ P,DPBSTR
MOVEI C,0
IDPB C,A ;MAKE IT ASCIZ
MOVEI C,MSBUFR
SENTTY: MOVEI D,B
TTYMES D, ;SEND IT
JFCL
BEEP B,
POPJ P,
DPBSTR: HRLI C,440700 ;DEPOSIT ASCIZ C IN BPT A
ILDB E,C
JUMPE E,CPOPJ
IDPB E,A
JRST .-3
DPBNAM: JUMPE C,CPOPJ
TLNE C,770000
JRST .+3
LSH C,6
JRST .-3
MOVE D,[POINT 6,C]
ILDB E,D
JUMPE E,CPOPJ
ADDI E,40
IDPB E,A
JRST .-4
MSBUFR: BLOCK 20
>;repeat 0
;VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
COMMENT ⊗
Modified 8/2/80 by BH, to use VALDAT[RMD,SYS] instead of mfd
for validation. VALDAT's first record is an index into the rest of
the file for USETIing for extra speed; the rest is sorted PRGs from
the mfd. Don't believe any MFDxxx labels, it's really reading VALDAT. ⊗
VALID: SKIPN T1,MLDEST ;ALWAYS OK TO :FILE
JRST VALFIL ; IF THE PPN EXISTS. BH 8/17/80
SKIPE FWDING ;ALWAYS OK IF FORWARDING
JRST VWINS
TLNE T1,-1 ;Cannot mail to prj,prg now
JRST VLDONE ;Nor to prj,*
MOVE T1,[POINT 6,MLDEST,17]
VALCL1: MOVE T2,T1
ILDB T3,T1
JUMPE T3,VALCL1
MOVEM T2,FBPINI
MOVE T2,[PUSHJ P,VSXCHR]
MOVEM T2,FBPXCT
PUSHJ P,TRYFOR
JRST VWINS ;FORWARDING WINS
MOVSI C,'DSK'
PUSHJ P,GETMFD
JRST NOMFD
MFDLP: PUSHJ P,MFDIN ;GET UFD NAME
JRST VTRYFT ;EOF
COMMENT ⊗
MOVE T2,T1
MOVEI T1,UFDN-1 ;FLUSH THE REST OF THE ENTRY
MOVEM T1,DIRFLC
MFDLP1: PUSHJ P,MFDIN
JRST VTRYFT
SOSLE DIRFLC
JRST MFDLP1
JUMPE T2,MFDLP ;IGNORE ZERO PPN
MOVE T1,MLDEST
; TLNN T1,-1
HRRZS T2
; TRNN T1,-1
; HLLZS T2
CAME T1,T2
⊗
CAME T1,MLDEST
JRST MFDLP
VWINS: AOS (P)
VLDONE: RELEAS .MFD,
POPJ P,
GETMFD: MOVEM C,MOPEN+1
OPEN .MFD,MOPEN ;CHECK DEST LIST AGAINST MFD
POPJ P,
PUSH P,JOBFF
MOVEI T1,MFDIBF
MOVEM T1,JOBFF
INBUF .MFD,2
POP P,JOBFF
;;; MOVE T1,MFDNAM
MOVE T1,['MAISYS']
MOVEM T1,MFDNAM+3
LOOKUP .MFD,MFDNAM
POPJ P,
INPUT .MFD, ;READ VALDAT INDEX
MOVE T1,MLDEST ;THING TO CHECK IN INDEX
TRNN T1,777700 ;SINGLE-CHAR?
JRST GTM1CH ;YES, START AT BEGINNING OF DATA
MOVEI T2,=27 ;BEGINNING OF 3-CHAR STUFF IN INDEX
TRNN T1,770000 ;TWO-CHAR?
TDZA T2,T2 ;YES, START AT BEGINNING OF INDEX
LSH T1,-6 ;NO, FIRST CHAR IS OVER HERE
LSH T1,-6 ;RIGHT ADJUST FIRST CHAR
SUBI T1,'A'
JUMPGE T1,.+2
MOVNI T1,1 ;ANYTHING BELOW A IS -1
ADDI T2,1(T1) ;FINAL INDEX POSITION
MOVE T1,MBUF+1
IBP T1 ;I FORGET WHAT THE BPT LOOKS LIKE INITIALLY
ADDI T2,(T1) ;THIS IS POINTER TO INDEX WORD IN CORE
USETI .MFD,@(T2)
GTM1CH: SETZM MBUF+2
JRST POPJ1
MFDIN: SOSG MBUF+2 ;READ A WORD FROM MFD
IN .MFD,
JRST MFDIN1
STATO .MFD,20000
JRST NOMFD
POPJ P,
MFDIN1: ILDB T1,MBUF+1
JRST POPJ1
VTRYFT: MOVE T1,MLDEST
TLNE T1,-1 ;IF DEST ISN'T JUST PRG,
JRST VLDONE ;WE'VE HAD IT
JRST TRYFAC ;BUT IF SO GIVE FACT.TXT A CHANCE
MOPEN: 10
SIXBIT /DSK/
XWD 0,MBUF
MBUF: BLOCK 3
COMMENT ⊗
MFDNAM: SIXBIT / 1 1/
SIXBIT /UFD/
0
SIXBIT / 1 1/
⊗
MFDNAM: 'VALDAT'
0
0
SIXBIT /MAISYS/
NOMFD: REPMES (451 System error, can't read master user list.)
VSXCHR: MOVEI A,0
TLNN F,770000
POPJ P,
ILDB A,F
ADDI A,40
POPJ P,
VALFIL: JUMPE D,CPOPJ ;MAIL TO FILE, MUST BE A PPN
MOVEM D,VALFPP ;SAVE FOR LOOKUP
MOVE T1,[' 1 1'] ;PUT MFD PPN IN LOOKUP BLOCK
MOVEM T1,VALFPP+3
INIT .MFD,17
'DSK '
0
POPJ P, ;GOTTA BE A DISK
LOOKUP .MFD,VALFPP ;LOOK FOR THE UFD
JRST VLDONE ;NO, CAN'T MAIL TO FILE IN IT
JRST VWINS ;YES, OK
VALFPP: 0
'UFD '
0
' 1 1'
;MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR
IFN FTFRM,<
MFRINI: TLNE FLG,MFRDUN ;INIT FINDING "FROM" LINE IN HEADER
POPJ P, ;NOTHING TO DO IF FOUND ALREADY
TLZ FLG,MFRWIN+MFRLUZ
MOVE MBP,[POINT 7,[ASCIZ /FROM: /]]
CAIN A," " ;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
POPJ P, ; WHERE "CATCH" MEANS IGNORE
MFRCHR: TLNE FLG,MFRLUZ!MFRDUN ;HERE FOR EACH CHAR
POPJ P, ;IF LOSING, LOSE
TLNE FLG,MFRWIN ;IF WINNING,
JRST MFRING ; WIN
ILDB MCH,MBP ;NOT SURE YET. GET A TRIAL CHAR
JUMPE MCH,MFRSTR ;IF NO MORE TO TEST, START WINNING
CAILE A,140 ;STRANGE UC/LC CONVERSION
ADDI MCH,40 ; NAMELY MAKE THE MASK AGREE
CAIE A,(MCH) ;TEST FOR EQUAL
TLO FLG,MFRLUZ ;NOPE, LOSING
POPJ P,
MFRSTR: TLO FLG,MFRWIN ;THIS IS THE FROM LINE
MOVE MBP,[POINT 7,MFRBUF]
MFRING: CAIE A,12 ;WINNING LINE:
CAIN A,15 ;IS IT OVER?
JRST MFROVR ;YUP
CAIN A,42 ;DOUBLE QUOTE?
JRST MFRQTE ;YES, CHANGE TO TWO SINGLE QUOTES!
IDPB A,MBP ;SAVE WINNING CHAR
POPJ P,
MFRQTE: MOVEI MCH,47 ;RIGHT SINGLE QUOTE
IDPB MCH,MBP ;Two of them to simulate double quote
IDPB MCH,MBP
POPJ P,
MFROVR: MOVEI MCH,0 ;FROM FINISHED
IDPB MCH,MBP ;MARK END OF FROM LINE
TLZ FLG,MFRWIN+MFRLUZ ;NOT IN PROGRESS ANYMORE
TLO FLG,MFRDUN ;DON'T LOOK AGAIN
POPJ P,
>;IFN FTFRM
;MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR
IFN FTMSJ,<
MSJINI: TLNE FLG,MSJDUN ;INIT FINDING "SUBJECT" LINE IN HEADER
POPJ P, ;NOTHING TO DO IF FOUND ALREADY
TLZ FLG,MSJWIN+MSJLUZ
MOVE MSJ,[POINT 7,[ASCIZ /SUBJECT: /]]
CAIN A," " ;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
POPJ P, ; WHERE "CATCH" MEANS IGNORE
MSJCHR: TLNE FLG,MSJLUZ!MSJDUN ;HERE FOR EACH CHAR
POPJ P, ;IF LOSING, LOSE
TLNE FLG,MSJWIN ;IF WINNING,
JRST MSJING ; WIN
ILDB MCH,MSJ ;NOT SURE YET. GET A TRIAL CHAR
JUMPE MCH,MSJSTR ;IF NO MORE TO TEST, START WINNING
CAILE A,140 ;STRANGE UC/LC CONVERSION
ADDI MCH,40 ; NAMELY MAKE THE MASK AGREE
CAIE A,(MCH) ;TEST FOR EQUAL
TLO FLG,MSJLUZ ;NOPE, LOSING
POPJ P,
MSJSTR: TLO FLG,MSJWIN ;THIS IS THE SUBJECT LINE
MOVE MSJ,[POINT 7,MSJBUF]
MSJING: CAIE A,12 ;WINNING LINE:
CAIN A,15 ;IS IT OVER?
JRST MSJOVR ;YUP
CAIN A,42 ;DOUBLE QUOTE?
JRST MSJQTE ;YES, CHANGE TO TWO SINGLE QUOTES!
IDPB A,MSJ ;SAVE WINNING CHAR
POPJ P,
MSJQTE: MOVEI MCH,47 ;RIGHT SINGLE QUOTE
IDPB MCH,MSJ ;Two of them to simulate double quote
IDPB MCH,MSJ
POPJ P,
MSJOVR: MOVEI MCH,0 ;SUBJECT FINISHED
IDPB MCH,MSJ ;MARK END OF SUBJECT
TLZ FLG,MSJWIN+MSJLUZ ;NOT IN PROGRESS ANYMORE
TLO FLG,MSJDUN ;DON'T LOOK AGAIN
POPJ P,
>;IFN FTMSJ
;NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STAPRO LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO
begin sixwrt
GLOBAL A,C
↑sixwrt:movei c,6
wrlp: movei a,
lshc a,6
jumpe a,wrsoj
addi a,40
pushj p,PUTCH1 ;WAS ASCIIC, FUCK IT
wrsoj: sojg c,wrlp
popj p,
bend sixwrt
;; STAT, FLST -- Send directory status LIST, NLST, STATDO
repeat 0,< ;whole page
NLST:
LIST: SKIPE DOACTV ;THIS CHECK MUST BE THE FIRST THING
JRST RETRX0
TLO FLG,LISTFL ;SET FLAG
JRST STAT1
STAT: SKIPE DOACTV ;DON'T DO IT IF THINGS ARE HAPPENING
JRST RETRX0
TLZ FLG,LISTFL ;CLEAR LIST FLAG
STAT1:
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
PUSHJ P,GPPFIL ;GET A FILE OR PPN
JRST STORX1
JUMPN D,STAT2 ;IF NO NAME, USE CURRENT
MOVE D,ALIPPN
STAT2: MOVEM D,STAPPN# ;SAVE PPN FOR HEADER
MOVEM D,STAPP1# ;SAVE AGAIN FOR WILD PPN HACK
MOVEM C,STADEV#
JUMPN F,.+2
MOVSI F,'* ' ;GFN SOMETIMES ZEROS IT WRONGLY
MOVEM F,STANAM# ;STAT TAKES FN AND EXT TOO
MOVEM E,STAEXT#
PUSHJ P,FLUSCS ;FLUSH USER ID LINE
MOVEI A,2 ;SET LOCAL BYTE TYPE
MOVEM A,DOTYPE
MOVEI A,=36 ;AND 36-BIT BYTES
MOVEM A,DOBS
TLNE FLG,LISTFL ;IF LIST,
JRST [SETOM DOACTV↔POPJ P,] ; WE DO THE REST IN DO MODE
REJOIN: MOVEI F,(D) ;SEPARATE PRJ AND PRG
HLRZ E,D
CAIE F,'*'
CAIN E,'*'
JRST STWILD ;WILD PPN
PUSHJ P,DOSTAT ;NOT WILD PPN, ONLY DO ONCE
STDONE: TLNE FLG,LISTFL
JRST LIDONE ;LIST IS DIFFERENT
PUSHJ P,IMPSTR
ASCIZ /200 That's all, folks!
/
RELEASE FOMP,
POPJ P,
LIDONE: PUSHJ P,DOMPSTR
ASCIZ /252 LIST completed successfully
/
JRST DOEOF1
STWILD: MOVE C,STADEV
PUSHJ P,GETMFD ;WILD PPN, READ THE MFD
JRST NOMFD
STWLP: PUSHJ P,MFDIN
JRST STDONE
MOVE T2,T1 ;SAVE ENTRY
MOVEI T1,UFDN-1 ;FLUSH THE REST OF THE ENTRY
MOVEM T1,DIRFLC
STWLP1: PUSHJ P,MFDIN
JRST STDONE
SOSLE DIRFLC
JRST STWLP1
JUMPE T2,STWLP ;SKIP EMPTY SLOTS
HLRZ T1,T2 ;SEPARATE PRJ AND PRG IN MFD ENTRY
HLRZ T3,STAPP1
CAIE T3,(T1) ;COMPARE PRJ
CAIN T3,'*'
JRST .+2
JRST STWLP ;NOPE
HRRZ T3,STAPP1
CAIE T3,(T2) ;COMPARE PRG
CAIN T3,'*'
JRST .+2
JRST STWLP
MOVEM T2,STAPPN ;WIN, SAVE FOR DOSTAT
PUSHJ P,DOSTAT ;HIT ME
JRST STWLP
DOSTAT: MOVE F,STAPPN
MOVE C,STADEV
MOVSI E,'UFD'
MOVE D,['1 1']
PUSHJ P,WAITIL
MOVEI B,5 ;CODE FOR UFD READ
MOVEM B,STORTYPE
PUSHJ P,ILDDEV ;OPEN FILE FOR OUTPUT
JRST STAPRO ;UFD PROTECTION FAILURE
MOVEI C,20
STATLP: TLNN FLG,LISTFL
JRST STALP1 ;STAT AND LIST HAVE DIFFERENT WAIT TESTS
SOJG C,STALP2
PUSHJ P,SXACTV ;I HATE THIS PROGRAM!
PUSHJ P,DOWAIT
MOVEI C,20
JRST STALP2
STALP1: SKIPGE SYNCH
PUSHJ P,CIWAIX ;GIVE ABORT A CHANCE
STALP2: PUSHJ P,GETFIL ;C(A) ← BYTE OF DATA FROM FILE
JRST STATERR
JRST STATEOF
JUMPE A,NXTFIL ;SKIP ALL IF FILE NO EXIST
MOVEM A,STAFL1#
PUSHJ P,GETFIL ;EXTENSION
JRST STATERR ;NEITHER WILL HAPPEN (READS EVEN # OF FILES)
JRST STATEOF
HLLZS A
MOVEM A,STAEX1#
MOVE B,STAEXT
CAME B,A
CAMN B,['* ']
JRST .+2 ;EXT MATCHES OR WILD
JRST NXTFL2
MOVE A,STAFL1
MOVE B,STANAM
CAME B,A
CAMN B,['* ']
JRST .+2
JRST NXTFL2
TLNE FLG,LISTFL
JRST LISTIT ;DIFFERENT OUTPUT ROUTINE FOR LIST CMD
SKIPN STAPPN ;HAVE WE TOLD HIM THE PPN YET?
JRST STAPOK ;YES
PUSHJ P,IMPSTR ;PRINT WHOSE
ASCIZ /151 [/
HLLZ B,STAPPN
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,ASCIIC
HRLZ B,STAPPN
PUSHJ P,SIXWRT
PUSHJ P,IMPSTR
ASCIZ /]
/
SETZM STAPPN ;FLAG NOT TO DO IT AGAIN
STAPOK: MOVE B,STAFL1
PUSHJ P,IMPSTR
ASCIZ /151 /
PUSHJ P,SIXWRT ;FILE
HLLZ B,STAEX1 ; . EXT?
JUMPE B,NXTFL1
MOVEI A,"." ; . EXT
PUSHJ P,ASCIIC
PUSHJ P,SIXWRT
NXTFL1: PUSHJ P,IMPCR
NXTFL2: SKIPA A,[UFDN-2] ;SKIP UFDN-2 WORDS
NXTFIL: MOVEI A,UFDN-1 ;SKIP UFDN-1 WORDS
ADDM A,FOBUF+1 ;OK TO DO, SINCE INCREMENTAL # OF
MOVNS A ; UFD ENTRIES PER RECORD
ADDM A,FOBUF+2
JRST STATLP
STATEOF:POPJ P,
STATERR:
POP P,(P)
TLNE FLG,LISTFL ;GOTTA DO THE RIGHT MPSTR
JRST DOERR
PUSHJ P,IMPSTR
ASCIZ /453 STAT incomplete, local file system error
/
RELEAS FOMP,
POPJ P,
STAPRO: MOVE A,STAPP1 ;PROTECTION FAILURE:
TLNN FLG,LISTFL
CAME A,STAPPN ;IF WILD PPN,
POPJ P, ; IGNORE IT
JRST ILDERR ;ELSE TELL HIM
LISTIT: MOVE B,STAFL1 ;PUT OUT A FILESPEC ON DATA LINK
PUSHJ P,PUT6
SKIPN B,STAEX1
JRST LISTI1
MOVEI A,"."
PUSHJ P,PUT1
PUSHJ P,PUT6
LISTI1:
REPEAT 0,< ; TENEX DOES NOT INCLUDE THE DIRECTORY NAME,
; AND THIS FUCKS TOPS-20 UP THE ASS!
MOVEI A,"["
PUSHJ P,PUT1
HLLZ B,STAPPN
PUSHJ P,PUT6
MOVEI A,","
PUSHJ P,PUT1
HRLZ B,STAPPN
PUSHJ P,PUT6
MOVEI A,"]"
PUSHJ P,PUT1
>;END REPEAT 0
MOVEI A,15
PUSHJ P,PUT1
MOVEI A,12
PUSHJ P,PUT1
JRST NXTFL2
PUT1: SOSG DOBUF+2
PUSHJ P,DOROU3
IDPB A,DOBUF+1
POPJ P,
PUT6: MOVE D,[POINT 6,B]
PUT61: ILDB A,D
JUMPE A,PUT62
ADDI A,40
PUSHJ P,PUT1
PUT62: TLNN D,770000
POPJ P,
JRST PUT61
STATDO: PUSH P,DOTYPE ;HERE FROM DO ROUTINE TO START XFER
PUSH P,DOBS ;IDCON AND ILDDEV USE DIFFERENT VALUES
SETZM DOTYPE ;BECAUSE WE READ UFD IN IMAGE MODE
MOVEI A,10 ;BUT SEND NVT ASCII OVER DATA LINK
MOVEM A,DOBS
MOVEI B,0 ;RETR FLAG
PUSHJ P,IDCON ;SET UP NET LINK
JRST DOERR
POP P,DOBS ;WE CONTROL THE NET OUTPUT OURSELF
POP P,DOTYPE ; SO WE CAN LEAVE THESE IN ILDDEV MODE
PUSHJ P,WAITIL ;THIS IS A CROCK
MOVEI B,7 ;WILL CHANGE TO 5 LATER. FOR STOMES.
MOVEM B,STORTYP
MOVE A,STADEV
MOVEM A,ERRDEV
MOVE A,STANAM ;SET UP VARS AS IF FROM ILDDEV
MOVEM A,ERRFIL
MOVE A,STAEXT
HLLZM A,ERREXT
MOVE A,STAPPN
MOVEM A,ERRPPN
SETOM HOLDIL ;PROTECT OURSELF
MOVEI A,DOMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
PUSHJ P,ASCII1
[ASCII /250 /]
PUSHJ P,STOMES ;SEND OPERATION NAME AND FILESPEC
MOVE E,[POINT 7,[ASCIZ / started correctly.
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
MOVE D,STAPPN
JRST REJOIN
>;repeat 0
;RETR RETRX0 ASCERR
repeat 0,< ;whole page
;; RETR ROUTINE
RETR: SKIPE DOACTV
JRST RETRX0
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
TLZ FLG,LISTFL ;NOT LIST COMMAND
MOVEI B,0 ;DO FLAG
PUSHJ P,GETSET ;SET UP TYPE, BYTE SIZE
JRST ASCERR ;ERROR RETURN, TYPE A NOT BYTE 8
PUSHJ P,GFN ;GET FILE NAME
JRST RETRX1 ; DIDN'T GET ONE
PUSHJ P,WAITIL
MOVEI B,1
MOVEM B,STORTYP ;"STOR"TYP IS NOW REALLY ILD-TYPE
SETOM HOLDIL
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST ILDERR
MOVEM F,DOACS+F ;WHAT??????????????????????????
; MOVEM F,DOACS+F ;??????????????????????????????
; MOVEM F,DOACS+F
; MOVEM F,DOACS+F
SETOM DOACTV
JRST FLUSCS
RETRX0: PUSHJ P,IMPSTR
ASCIZ /505 You are already RETRing
/
JRST FLUSCS
ASCERR: PUSHJ P,IMPSTR
ASCIZ /457 TYPE A must be BYTE 8
/
JRST FLUSCS
>;repeat 0
;WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEGO MODE MODEUN MODEOK STRU XRSQ
repeat 0,<
;; TYPE, MODE, STRU ROUTINES
WHICHA: ;CALL: MOVEI A,<ASCII CHARACTER>
; MOVE B,[POINT 7,[ASCIZ /<LIST OF ASCII CHARACTERS>/]
; PUSHJ P,WHICHA
; RETURN HERE, B,C,D CLOBBERED, A=0,1,2 DEPENDING ON POSITION
; IN LIST WHICH MATCHED ORIGINAL C(A), OR A=-1 IF NONE.
MOVE C,A
SETZ A,
WHICHB: ILDB D,B
JUMPE D,[SETO A, ↔ POPJ P,]
CAMN D,C
POPJ P,
AOJA A,WHICHB
TYPE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /AILPE/]]
PUSHJ P,WHICHA
JUMPL A,[REPMES (503 Unrecognized type)]
JRST .+1(A)
JRST TYPEOK
JRST TYPEOK
JRST TYPEOK
JRST TYPEOK
JRST TYPEUN
TYPEUN: REPMES (506 Unimplemented type)
TYPEOK: SKIPN DIACTV
SKIPE DOACTV
JRST [REPMES (504 Both data channels busy)]
TYPEGO: MOVEM A,RTYPE ;SAVE REAL TYPE AS RECEIVED
REPMES (200 Type OK)
MODE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /SBTH/]]
PUSHJ P,WHICHA
JUMPL A,[REPMES (503 Unrecognized mode)]
JRST .+1(A)
JRST MODEOK
JRST MODEUN
JRST MODEUN
JRST MODEUN
MODEUN: REPMES (506 Unimplemented mode)
MODEOK: SKIPN DIACTV
SKIPE DOACTV
JRST [REPMES (504 Both data channels busy)]
REPMES (200 Mode OK)
STRU: PUSHJ P,GETCAP
CAIN A,"F"
JRST [REPMES (200 File structure OK)]
CAIN A,"R"
JRST [REPMES (506 Record structure not implemented)]
REPMES (503 Unrecognized structure)
XRSQ: PUSHJ P,XRSRST ; Always reset state of XRCP.
;; SETZM XRFOBP ; Reset R-first too.
PUSHJ P,GETCAP
CAIN A,"?"
JRST [REPMES (215 R Recipients first please.)]
CAIN A,"R"
JRST [MOVEM A,XRSQSW ; positive value selects R
REPMES (<200 Okay, R scheme.>)]
CAIN A,"T"
JRST [SETOM XRSQSW ; Select T scheme!!
REPMES (200 Win!)]
SETZM XRSQSW ; Don't grok, reset to default.
REPMES (501 Don't know that scheme.)
>;repeat 0
;DECIN DECIN0 SOCK
repeat 0,<
;; BYTE, SOCK ROUTINES
DECIN: ;READ A DECIMAL ARGUMENT (TERMINATED BY SPACE OR CR) FROM IMP
;CALL: PUSHJ P,DECIN
; ERROR RETURN (NON NUMERIC IN ARGUMENT)
; NORMAL RETURN (C(B) = NUMBER, C(A)=DELIMETER)
SETZ B,
DECIN0: PUSHJ P,GETCHR
CAIE A,15 ;CR?
CAIN A," " ;SPACE?
JRST CPOPJ1 ; YES TO EITHER
CAIL A,"0"
CAILE A,"9"
POPJ P, ;ILLEGAL CHARACTER
IMULI B,=10
ADDI B,-"0"(A)
JRST DECIN0
SOCK: PUSHJ P,DECIN
JRST [REPMES (501 Bad SOCK argument)]
CAML B,[1B4] ;SOCKET NUMBER WILL FIT IN 32 BITS
JRST [REPMES (503 Socket number too big)]
ILDB C,[POINT 1,B,35]
TRC C,1 ;FOREIGN COMPLIMENT OF LOCAL DIRECTION
MOVEM B,FDRS(C) ;STORE IN FDRS OR FDSS
CAIE A,15 ;C.R. WAS THE TERMINATING CHR.?
JRST SOCK ; NO, GET ANOTHER ARGUMENT
REPMES (<200 SOCK argument(s) OK>)
>;repeat 0
;BYTE BYTE2 BYTE4 BYTE9
repeat 0,<
BYTE: PUSHJ P,DECIN
JRST [REPMES (501 Bad argument to BYTE)]
SKIPE DIACTV
SKIPN DOACTV
CAIA
JRST [REPMES (504 Can't reset byte size - both data channels are busy!)]
CAILE B,=255
JRST [REPMES (503 Byte size too big)]
CAIE B,=8
CAIN B,=32
JRST BYTE4 ;THESE BYTE SIZES OK
PUSHJ P,BYTE9 ;IS 36 MOD BYTESIZE = 0?
BYTE2: JRST [REPMES (506 Byte size must be 8, 32, or factor of 36)]
BYTE4: MOVEM B,RBS ;SAVE "REAL" BYTE SIZE
REPMES (200 Byte size OK)
BYTE9: MOVEI C,=36
IDIV C,B ;IS 36 MOD (BYTESIZE) = ZERO?
JUMPE D,CPOPJ1 ; YES
POPJ P, ; NO
>;repeat 0
;PASS NOPRVS WRONGP GIVUSR MUSTLG PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE
repeat 0,<
; USER, PASS ROUTINES
PASS: TLNN FLG,(PASSBT) ;Password already given?
TLNN FLG,(USREBT) ;User not given?
JRST GIVUSR ;Yes, tell him to give user name first
SETZ T3, ;Read password, no break characters
PUSHJ P,SIXINL
TRNN T,77 ;Right justified?
JUMPN T,[ROT T,-6 ;No, try advancing a character
JRST .-1]
MOVEM T,PASMTA+3 ;Compare with UFD
MTAPE .PASS,PASMTA
JRST WRONGP
PUSHJ P,IMPSTR
ASCIZ/230 Password OK, happy hacking
/
MOVE T3,PPNTMP ;Copy saved PPN
MOVEM T3,UPPN
MOVEM T3,ALIPPN ;Set alias, too
HRRZM T3,UPRG ;SAVE FOR CAME WRT MASPRV IN ILDDEV
SETZM PRIVS ;NO PRIVILEGES YET
MTAPE .PASS,PRVMTA ;READ PRIVILEGES
JRST NOPRVS
MOVE T3,PRIVWD ;GET PRIVS FROM UFD
MOVEM T3,PRIVS ;SAVE THEM
SETZM PASWD ;JUST IN CASE WE HAVE INF
NOPRVS: TLO FLG,(PASSBT)
IFN FTREQL,<
SETOM USEROK ;note password given
>;IFN FTREQL
RELEASE .PASS,
JRST FLUSCS
WRONGP: PUSHJ P,IMPSTR
ASCIZ/431 Password rejected. Shame on you.
/
MOVE T3,['NETSYS']
MOVEM T3,UFDFIL
MOVE T3,[SIXBIT/ 1 1/]
MOVEM T3,UFDFIL+3
INIT .PASS,17
SIXBIT/DSK/
0
JRST ERRKIL
LOOKUP .PASS,UFDFIL
JRST ERRKIL
MOVEM T,PASMTA+3 ;Compare with UFD
MTAPE .PASS,PASMTA
CAIA
JRST [MOVE T3,PPNTMP ;For FTP debugging
MOVEM T3,UPPN
MOVEM T3,ALIPPN
HRRZM T3,UPRG
SETOM PRIVS
JRST NOPRVS]
SOSLE PASTRY ;Too many attempts?
JRST FLUSCS ;No, let him/her try again
MOVEI D,1 ;Yes, obviously a password hacker. Flush!
SLEEP D, ;Wait a sec to send lose message
JRST ERRKIL ;Now, flush!
GIVUSR: PUSHJ P,IMPSTR
ASCIZ /504 No USER command given
/
JRST FLUSCS
IFN FTREQL,<
MUSTLG: PUSHJ P,IMPSTR
ASCIZ /504 You forgot to log in; must give USER command.
/
JRST FLUSCS
USEROK: 0 ;nonzero if USER command given with password
>;IFN FTREQL
PASFOO: REPMES (453 System error, can't check password.)
USER: SETZM PRIVS ;NO PRIVILEGES ANYMORE
SETOM USRCMD#
PUSHJ P,GPPN ;GET PPN IN SIXBIT INTO ACCUMULATOR D
JRST USER1 ; DIDN'T GET IT
MOVEM D,UFDFIL ;Check for valid user name
MOVEM D,PPNTMP ;SAVE HERE FOR PASS
IFE FTREQL,< ;if requiring login, don't allow guest login
CAME D,['ANONYM']
CAMN D,['NETGUE'] ;LET THIS ONE IN BUT WITH GUEST STATUS
JRST INFREE
>;IFE FTREQL
MOVE D,[SIXBIT/ 1 1/]
MOVEM D,UFDFIL+3
INIT .PASS,17
SIXBIT/DSK/
0
JRST PASFOO
LOOKUP .PASS,UFDFIL
JRST [ HRRZ D,UFDFIL+1 ;File not found?
JUMPE D,USER4 ;Yes, unknown user
CAIN D,2 ;Protection violation perhaps?
JRST USER3 ;Yes, can't check password then
JRST PASFOO]
SETZM PASMTA+3 ;Check for password
MTAPE .PASS,PASMTA
JRST ASKPAS ;Something there, ask for it
USER3: PUSHJ P,IMPSTR ;None, don't let him/her thru
ASCIZ *432 No remote login for that account.
*
JRST FLUSCS
ASKPAS: TLZ FLG,(PASSBT) ;Forget old user
IFN FTREQL,<
SETZM USEROK ;no password given yet
>;IFN FTREQL
TLO FLG,(USREBT) ;Remember we got a user name
MOVEI D,5 ;Set number of tries for password
MOVEM D,PASTRY
PUSHJ P,IMPSTR ;Tell user we want a password
ASCIZ /330 What's yer password?
/
JRST FLUSCS
USER1: PUSHJ P,IMPSTR
ASCIZ *431 Invalid user name. Format is PRJ,PRG
*
JRST FLUSCS
USER4: PUSHJ P,IMPSTR
ASCIZ *431 I don't know you
*
JRST FLUSCS
CWD:
XCWD: PUSHJ P,GPPN ;GET PPN IN SIXBIT INTO ACCUMULATOR D
JRST USER1 ; DIDN'T GET IT
MOVEM D,ALIPPN ;Set user ppn
PUSHJ P,IMPSTR
ASCIZ /200 XCWD command accepted
/
JRST FLUSCS
ACCT: PUSHJ P,IMPSTR
ASCIZ/420 Acct ID not in hash table, add 1 and try again
/
JRST FLUSCS
IFE FTREQL,<
INFREE: TLZ FLG,(PASSBT+USREBT) ;SET HIS UPPN BUT NO LOCAL ACCESS.
MOVEM D,UPPN ;COULD IN PRINCIPLE BE OTHER THAN NETGUE
MOVEM D,ALIPPN ;IE "SPECIAL GUEST ACCT" HACK
HRRZM D,UPRG
PUSHJ P,IMPSTR
ASCIZ /230 Welcome to sunny California
/
JRST FLUSCS
>;IFE FTREQL
>;repeat 0
;GETCOM GETCO1 FLUSCS flcs1 GETCO2
;GETCOM,FLUSCS COMMAND STRING READER
GETCOM: ;CALL: PUSHJ P,GETCOM
; RETURN HERE, NON-SYNTACTICAL COMMAND
; RETURN HERE, C(C) = COMMAND (IN ASCIZ),
;CLOBBERS A,B,C,D
TLZ FLG,LFSEEN ;OK TO REALLY READ FROM IMP AGAIN (FLUSCS FAKEOUT HACK)
MOVNI D,-5 ;MAXIMUM LENGTH OF COMMAND (INCLUDING DELIMITER)
MOVE B,[POINT 7,C]
SETZ C,
PUSHJ P,GETCAP
CAIE A," "
CAIN A,11
JRST .-3 ;IGNORE LEADING TABS, SPACES
CAIA
GETCO1: PUSHJ P,GETCAP
CAIN A," " ;END OF COMMAND?
JRST CPOPJ1 ; YES, SUCCESS EXIT
CAIN A,15 ;IGNORE CR!
JRST GETCO1
CAIN A,12 ;PREMATURE END OF COMMAND LINE?
JRST GETCO2 ; YES
IDPB A,B
AOJL D,GETCO1 ;LOOP FOR NEXT COMMAND CHARACTER...
PUSHJ P,GSRCI
PUSHJ P,IMPST0 ; ... UNLESS TOO MANY ALREADY
ASCIZ /500 Command more than 4 characters: /
PUSHJ P,ASCII1
C
PUSHJ P,IMPCR
SOS IMPSTF
FLUSCS: ;FLUSH COMMAND STRING
ifn verbose,<
outchr [173] ;flushing (dcs: 4-12-73)
>;ifn verbose
flcs1: PUSHJ P,GETCHR ;GET CHARACTER
CAIE A,12 ;L.F.?
JRST FLCS1 ;LOOP FOR NEXT
ifn verbose,<
outchr [176]
>;ifn verbose
POPJ P, ; YES, EXIT (FAILURE EXIT FROM GETCOM)
;FLUSH WANTS TO SEE SOMETHING PERHAPS
GETCO2:
; AOS IBUF+2 ;BACK UP ONE IN COUNTER
; MOVE B,[100000,,0]
; ADDM B,IBUF+1 ; AND IN BUFFER
MOVEI A," " ;FAKE THE SPACE
JRST CPOPJ1
;GETIDX ANAMES
;GETIDX CONVERT COMMAND STRING TO INDEX
GETIDX: ;CALL: PUSHJ P,GETIDX
; RETURN HERE, C(A) = XWD <GARBAGE>,N
; N=0 - UNRECOGNIZED COMMAND
MOVSI A,-NNAMES
CAMN C,ANAMES(A)
AOJA A,CPOPJ
AOBJN A,.-2
SETZ A,
POPJ P,
DEFINE X(A,B) <ASCIZ /A/ ↔ >
ANAMES: NAMES
NNAMES ←← .-ANAMES
;⊗ PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3
;; PUTCHR - SEND ASCII CHARACTER OUT ON IMP CONTROL CONNECTION
PUTCH1:
ifn verbose,<
OUTCHR A
>;ifn verbose
PUTCHR: ;CALL: MOVE A,<ASCII CHARACTER>
; PUSHJ P,PUTCHR
; RETURN HERE ALWAYS, ALL ACCUMULATORS INTACT
JUMPE A,CPOPJ ;DON'T OUTPUT NULL CHARACTER
SOSG OBUF+2 ;ROOM IN BUFFER FOR THIS CHARACTER?
PUSHJ P,PUTBUF ; NO, MAKE ROOM BY OUTPUTTING BUFFER
PUSH P,A ;JUST IN CASE
;WAITS to ASCII character conversion
CAIN A,33
SOJA A,PUTCH2 ;not-equals
CAIN A,175
MOVEI A,33 ;altmode
CAIN A,176
MOVEI A,175 ;right brace
CAIN A,32
MOVEI A,176 ;tilde
PUTCH2: IDPB A,OBUF+1 ; STUFF IT IN
POP P,A
CAIE A,12 ;IT'S A LINE FEED?
POPJ P, ; NO
JRST PUTBUF ; YES, SEND OUT ENTIRE BUFFER, AND RETURN
PUTBUF: ;CALL: PUSHJ P,PUTBUF
; RETURN HERE ALWAYS
; OUTPUTS A BUFFER OF ASCII ON THE CONTROL IMP CONNECTION.
PUSH P,B ;GET AN ACCUMULATOR
PUSH P,A
PUTBU2: LDB B,[POINT 3,OBUF+1,2];PUT MAGIC BITS FOR NULL BYTES
MOVEI A,1
LSH A,(B)
SUBI A,1
IORM A,@OBUF+1
REPEAT 0,<
PUTBU2: LDB B,[POINT 6,OBUF+1,5]
CAIGE B,10 ;IS WORD FILLED OUT?
JRST PUTBU3 ; YES
SOS OBUF+2 ; NO, FILL IT OUT WITH NOP'S
MOVEI B,202
IDPB B,OBUF+1
JRST PUTBU2
>;REPEAT 0
PUTBU3: ;IT MIGHT BE NICE TO PUT A TEST HERE
; TO MAKE SURE WE CAN DO THE OUTPUT
; WITHOUT HANGING UP FOR ALLOCATION
; OR BLOCKED LINK OR WHATEVER.
; (IN WHICH CASE, IMPSTR,DIMPSTR,DOMPSTR
; SHOULD BE DISTINGUISHED, TO PREVENT
; INTERMIXING OF THEIR MESSAGES.)
POP P,A
POP P,B ;RESTORE ACCUMULATOR
OUT IMP, ;SEND OUT THE BUFFER
POPJ P, ; SUCCESS, RETURN
MES (OUT IMP fails)
; IN THIS CASE, TIS BETTER TO GO ON THAN TO QUIT
POPJ P, ;NO MATTER WHAT THE PROBLEM, IGNORE IT
; OR LET SOMEBODY ELSE FIND IT!
; (BECAUSE SOME MAIL's CLOSE DOWN BEFORE
; ACKNOWLEDGEMENT)
;⊗ GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
;; GETCHR - GET ASCII CHARACTER FROM IMP CONTROL CONNECTION
GETCHR: ;CALL: PUSHJ P,GETCHR
; RETURN HERE ALWAYS, C(A) HAS CHARACTER
; CLOBBER NO ACCUMULATORS
TLNE FLG,LFSEEN ;IS THIS COMMAND LINE ALREADY DONE?
JRST FAKELF ;YUP, KEEP RETURNING LF TO MAKE FLUSCS HAPPY.
RGETCH: SOSG IBUF+2 ;CHR IN BUFFER?
JRST GETCH2 ; NO, DO AN INPUT
GETCH1: ILDB A,IBUF+1
;; CAIN A,200 ;DATA MARK?
;; AOS SYNCH ; YES, UPDATE COUNT
;; SKIPL SYNCH ;IF SYNCH IS NEGATIVE, IGNORE INPUT
;;;;; CAIN A,202 ;NOP?
CAIL A,200 ;TELNET CONTROL?
JRST RGETCH ; YES, GET ANOTHER CHARACTER
JUMPE A,RGETCH ;IGNORE NULLS
ifn verbose,<
SKIPE SILENT ;HIDING THEIR INPUT?
JRST GETCH6 ;YES
trne a,200
outchr ["↑"]
outchr a
GETCH6:
>;ifn verbose
;; TRNE A,200 ;CONTROL CHARACTER?
;; POPJ P, ;RETURN, WHATEVER IT IS
;ASCII to WAITS character conversion
CAIN A,32
AOJA A,GETCH7 ;not-equals
CAIN A,176
MOVEI A,32 ;tilde
CAIN A,175
MOVEI A,176 ;right brace
CAIN A,33
MOVEI A,175 ;altmode
GETCH7: CAIN A,12
TLO FLG,LFSEEN ;NO MORE READING UNTIL NEXT GETCOM
CAIE A,15 ;don't save cr or lf
CAIN A,12
POPJ P,
SKIPE XRFBBP ; Are we saving XRCP recipient name?
SKIPE XRFBZZ ; And not overflowed?
CAIA
IDPB A,XRFBBP ; Yes, save char.
SKIPE XXBBP ; Are we saving recipient line?
SKIPE XXBZZ ; And not overflowed?
POPJ P,
IDPB A,XXBBP ; Yes, save char.
POPJ P,
GETCH2: PUSH P,F ;GET AN ACCUMULATOR
HRRZ F,IBUF ;GET POINTER TO BUFFER
HRRZ F,(F) ;GET POINTER TO NEXT BUFFER
SKIPGE (F) ;INPUT WAITING IN NEXT BUFFER?
JRST GETCH3 ; YES
INTMSK [0] ;TURN OFF INTERRUPTS
MTAPE IMP,[10] ;INPUT WAITING IN FREE STORAGE?
JRST GETCH4 ; NO
INTMSK [-1] ; YES, RE-ENABLE INTERRUPTS
GETCH3: POP P,F ;RESTORE ACCUMULATOR
IN IMP, ;DO THE INPUT
JRST GETCH1 ; AND FETCH THE CHARACTER
JRST GETCH5 ; OOPS! INPUT FAILED
GETCH4: INTMSK [-1]
POP P,F ;RESTORE ACCUMULATOR
GETCH5: PUSHJ P,CIWAIT
JRST GETCH2
GETCAP: PUSHJ P,GETCHR ;SAME AS GETCHR, EXCEPT CHANGES
CAIL A,"a" ; LOWER CASE TO UPPER CASE
CAILE A,"z" ; BEFORE RETURNING
POPJ P,
SUBI A,"a"-"A"
POPJ P,
FAKELF: MOVEI A,12
POPJ P,
;GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
; ROUTINES TO OUTPUT ASCII INFORMATION ON CONTROL CHANNEL
; NOTE: THE PRIVILEGE OF SENDING ASCII OUT ON CONTROL CHANNEL
; IS A "SCARCE RESOURCE", SINCE THE CI,DI AND DO ROUTINES MAY ALL
; TRY TO DO SO SIMULTANEOUSLY. THE FLAG "INPSTF" GOVERNS THE USE
; OF THESE ROUTINES.
; IMPORTANT: WHEN DONE, THE CALLING ROUTINE MUST RELEASE THE
; RESOURCE BY A "SOS IMPSTF" INSTRUCTION.
GSRCI: MOVEI A,IMP
GSR: ;Get Scarce Resource
;CALL: MOVEI A,<DIMP or DOMP or IMP>
; PUSHJ P,GSR
; RETURN HERE WITH CONTROL OF SCARCE RESOURCE
AOSG IMPSTF ;IS RESOURCE AVAILABLE?
POPJ P, ; YES
SOS IMPSTF ; NO
CAIN A,IMP
PUSHJ P,CIWAIT
; CAIN A,DIMP
; PUSHJ P,DIWAIT
; CAIN A,DOMP
; PUSHJ P,DOWAIT
JRST GSR
ASCII1: ;CALL: PUSHJ P,ASCII1
; <ADDRESS OF ONE WORD OF ASCII OR ASCIZ>
; RETURN HERE, 0,1,2,3,4,OR 5 CHARACTERS OUTPUT
;CLOBBERS ACCUMULATORS E,F
MOVNI F,5
PUSH P,A
MOVE E,[POINT 7,0]
HRR E,@-1(P)
ASCII2: ILDB A,E
JUMPE A,ASCII3 ;JUMP ON END OF ASCIZ STRING
PUSHJ P,PUTCH1 ;OUTPUT 1 CHARACTER
AOJL F,ASCII2 ;LOOP FOR NEXT CHARACTER
ASCII3: POP P,A
JRST CPOPJ1
ASCIIY: ILDB A,E
JUMPE A,ASCII3
PUSHJ P,PUTCH1
JRST ASCIIY
ASCIIE: ;CALL: MOVE E,[POINT 7,[ASCIZ /MESSAGE TO GO OUT ON IMP/]]
; PUSHJ P,ASCIIE
; RETURN HERE ALWAYS, ACCUMULATOR A LOST
PUSH P,[.+1] ;PUT <RETURN ADDRESS LESS ONE> ON STACK
PUSHJ P,ASCIIY ;THIS IMPLICIT RETURN ADDRESS IS CLOBBERED
POPJ P, ;THIS IS THE RETURN FROM ASCIIE
ASCIIC: PUSH P,A
PUSHJ P,GSRCI ;GET SCARCE RESOURCE -- IMP OUTPUT CONTROL
POP P,A
PUSHJ P,PUTCH1
SOS IMPSTF
POPJ P,
;⊗ DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH DOMARP WATHST MAXSIT IMPOCT
;; ANOTHER ROUTINE TO OUTPUT ASCII STRING TO IMP CONTROL CHANNEL
;; IMPST0 IS A ROUTINE TO OUTPUT AN ASCII STRING TO THE IMP CONTROL
;;CHANNEL. HOWEVER, SERVERAL DIFFERENT ROUTINES MAY WISH SIMULTANEOUS
;;ACCESS TO IMPST0, WHICH WOULD CAUSE THE MESSAGES GOING OUT TO BE INTER-
;;MINGLED, AND THEREFORE GARBLED. THUS, INPST0 IS TREATED AS A "SCARCE
;;RESOURCE", AND THE COUNTER "IMPSTF" INDICATES ITS AVAILIBILITY.
;; SO, IMPST0 HAS 3 ENTRY POINTS: DIMPSTR, DOMPSTR AND IMPSTR.
;;THESE CORRESPOND TO THE 3 ROUTINES DIROUT, DOROUT AND CIROUT.
repeat 0,<
DIMPSTR:AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,DIWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST DIMPSTR
DOMPSTR:AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,DOWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST DOMPSTR
>;repeat 0
IMPSTR: AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,CIWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST IMPSTR
IMPSTF: -1 ;MINUS ONE MEANS IMPST0 ROUTINE IS AVAILABLE
IMPST0: ;CALL: PUSHJ P,IMPST0
; ASCIZ /STRING TO BE OUTPUT/
; RETURN HERE
;CLOBBERS ACCUMULATOR E
POP P,E
PUSHJ P,IMPSTN ;output string pointed to by E
SOS IMPSTF
JRST 1(E)
;Output to IMP the ASCIZ string pointed to by RH E.
IMPSTN: HRLI E,(<POINT 7,0>)
ifn verbose,<
OUTSTR (E) ;type the message too, in case attached
>;ifn verbose
PUSH P,A
IMPST1: ILDB A,E
JUMPE A,IMPST2
PUSHJ P,PUTCHR
JRST IMPST1
IMPST2: POP P,A
POPJ P,
IMPCR: PUSHJ P,IMPSTR
ASCIZ /
/
POPJ P,
;routine to output our host name to the IMP
IMPSTH:
;; MOVE E,WAITST ;get waits site number
;; MOVE E,WATHST(E) ;get ptr to host name string
MOVEI E,OURSTR ;get ptr to our host name string
;; PUSHJ P,IMPSTN ;output host name to imp
;; MOVEI E,DOMARP ;get ptr to domain string (.ARPA)
JRST IMPSTN
;;DOMARP: ASCIZ/.ARPA/ ;domain string
repeat 0,<
WATHST: [ASCIZ/SU-AI/] ;site 0
[ASCIZ/SU-CCRMA/] ;site 1
[ASCIZ/S1-A/] ;site 2
[ASCIZ/New/] ;(always last) unknown sites will just say New
MAXSIT←←.-WATHST
>;repeat 0
IMPOCT: IDIVI A,10 ;octal output routine
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,IMPOCT
HLRZ A,(P)
ADDI A,"0"
JRST PUTCH1 ;output to IMP
;SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
;CR'S ARE IGNORED, ALSO LEADING SPACES AND TABS
;CALL: MOVE T3,[POINT 7,[ASCIZ /<BREAK CHARACTERS>/]]
; PUSHJ P,SIXINL/R
; RETURN HERE ALWAYS,
; C(T) = LEFT/RIGHT JUSTIFIED SIXBIT
; C(T1)= BREAK CHARACTER:
; ILLEGAL 6BIT(1-37),LF(12),OR FROM TABLE(1-177)
SIXINL: MOVE T2,[POINT 6,T]
TLOA FLG,LEFTF
SIXINR: TLZ FLG,LEFTF
SETZ T, ;PUSHJ TO HERE FOR RIGHT NORMALIZATION
PUSH P,A
PUSH P,T3 ;SAVE POINTER TO BREAK CHARACTERS
TLZ FLG,QUOTEF ;FLAG NO QUOTING IN PROGRESS
SIXIN1: ILDB A,XRRBBP ;C(A) GETS CHARACTER from rescanned string
MOVE T1,A
CAIN T1,42 ;QUOTE HACKING?
TLCA FLG,QUOTEF ;YES, TOGGLE FLAG AND CHECK STATE
CAIA
JRST SIXIN1
TLNE FLG,QUOTEF
JRST SIXIN3
CAIE T1,40
CAIN T1,11
JRST [JUMPE T,SIXIN1 ;IGNORE LEADING BLANKS AND TABS
JRST SIXIN4] ;ELSE RETURN
MOVE T3,(P) ;T3 ← POINTER TO BREAK CHARACTERS
SIXIN2: ILDB A,T3 ;A ← BREAK CHARACTER FROM TABLE
JUMPE A,SIXIN3 ;JUMP ON END OF BREAK TABLE
CAMN A,T1 ;MATCH WITH INPUT CHARACTER?
JRST SIXIN4 ; YES, GO EXIT
JRST SIXIN2 ;FETCH NEXT BREAK CHARACTER
SIXIN3: CAIL T1,"a"
CAILE T1,"z"
JRST .+2
TRZ T1,40 ;MAKE LOWER CASE INTO UPPER CASE
CAIGE T1,40
JRST SIXIN4 ;RETURN IF CHAR. HAS NO SIXBIT CODE
SUBI T1,40
ANDI T1,77
TLNE FLG,LEFTF ;LEFT JUSTIFIED SIXBIT?
JRST [ TLNE T2,770000 ;YES, ALREADY HAVE SIX CHARACTERS?
IDPB T1,T2 ;NO, STASH IT IN
JRST SIXIN1]
TLNE T,770000 ;ALREADY HAVE 6 CHARACTERS?
JRST SIXIN1 ; YES, FLUSH EXTRA CHARACTERS
LSH T,6
IOR T,T1
JRST SIXIN1 ;READ NEXT CHARACTER
SIXIN4: POP P,T3 ;RESTORE POINTER TO BREAK CHARACTERS
POP P,A ;RESTORE ACCUMULATOR A
POPJ P, ;AND RETURN
;GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF
;; CALL: PUSHJ P,GFN ;(Get File Name)
;; ERROR RETURN
;; SUCCESS RETURN, C(F) = FILENAME IN SIXBIT
;; C(E) = EXTENSION IN SIXBIT
;; C(D) = PPN IN SIXBIT
;; C(C) = DEVICE IN SIXBIT
;; CLOBBERS T,T1,T2,T3 ONLY
;; CALL: PUSHJ P,GPPN ;(Get PPN)
;; ERROR RETURN
;; SUCCESS RETURN, C(D) = PPN IN SIXBIT
;Jump here from MLNB. POPJs on error, double skips on success.
GFNML: SETZM MLDEST ;MAIL TO :FILE or via indirect file (@)
SETOM DISFIL ;distribution file (or direct file)
;; MOVEM A,MBOXCH ;SAVE # OR @ FOR MAIL COMMAND
MOVE D,[' PDOC'] ;DEFAULT PPN FOR @ FILE
MOVEI E,0 ;NO DEFAULT EXT FOR @ FILE (MAIL handles it)
CAIE A,"@" ;USE ABOVE DEFAULTS FOR INDIRECT FILE
GFN: SETZB D,E ;DEFAULT EXT AND PPN
TLZ FLG,MFNMF
MOVSI C,'DSK' ;DISK IS ASSUMED DEVICE
MOVE T3,[POINT 7,[ASCIZ /:.[@/]]
PUSHJ P,SIXINL
GFN0: CAIE T1,":"
JRST GFN0A
MOVE C,T
MOVE T3,[POINT 7,[ASCIZ/.[@/]]
PUSHJ P,SIXINL
GFN0A: MOVE F,T ;SET FILE NAME
CAIE T1,"." ;EXTENSION IS NEXT?
JRST GFN1 ; NO
MOVE T3,[POINT 7,[ASCIZ /[@/]]
PUSHJ P,SIXINL
;;; This change installed for the benefit of a multiple STOR
;;; from a tenex with longer filenames, so we truncate the ext instead of
;;; refusing the transfer
HLLZS T
;;; TRNE T,-1 ;EXTENSION NAME MORE THAN 3 CHARACTERS?
;;; POPJ P, ; YES, ERROR RETURN
MOVE E,T ;SET EXTENSION NAME
GFN1: CAIE T1,"[" ;PPN IS NEXT?
JRST CPOPJ2 ; NO, SUCCESS EXIT
GPPN1: ;ENTER HERE FOR PPN ONLY
MOVE T3,[POINT 7,[ASCIZ /,]@/]]
PUSHJ P,SIXINR
repeat 0,<
AOSE USRCMD#
JRST GPPN2
CAMN T,['ANONYM']
JRST GPPWIN
CAIN T1,","
JRST GPPN2
TLNE T,-1
POPJ P,
HRLI T,'1'
JRST GPPWIN
>;repeat 0
GPPN2: TLNE T,-1 ;PROJECT NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
MOVS D,T
JUMPE T,CPOPJ2 ;THIS IS NO PPN ON GPPN ENTRY
CAIE T1,"," ;PROJECT & PROGRAMMER NAMES DELIMITED OK?
JRST GPPN3 ; NO, JUST PROJECT CODE
MOVE T3,[POINT 7,[ASCIZ /]@/]]
PUSHJ P,SIXINR
TLNE T,-1 ;PROGRAMMER NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
HRR D,T ;SET PPN
JRST CPOPJ2 ;SUCCESS RETURN
GPPN3: TLNE FLG,MFNMF ;IF MLFLNM, TAKE ERROR RETURN SIGH
POPJ P,
HRR D,ALIPPN ;GET DEFAULT PROGRAMMER NAME
JRST CPOPJ2
repeat 0,<
GPPWIN: MOVE D,T
JRST CPOPJ1
GPPN: TLZ FLG,MFNMF
GPPNX: MOVE T3,[POINT 7,[ASCIZ /[,/]]
PUSHJ P,SIXINR
JUMPE T,GPPN1
AOSE USRCMD#
JRST GPPN2
CAMN T,['ANONYM']
JRST GPPWIN
CAIN T1,","
JRST GPPN2
TLNE T,-1
POPJ P,
HRLI T,'1'
GPPWIN: MOVE D,T
JRST CPOPJ1
;; GPPFIL: LIKE GFN BUT ACCEPTS "PRJ,PRG" TO MEAN "*.*[PRJ,PRG]"
;THIS IS COMPLETELY WRONG.
GPPFIL: MOVSI F,'* '
MOVSI E,'* '
MOVEI D,0
MOVSI C,'DSK'
TLZ FLG,MFNMF
MOVE T3,[POINT 7,[ASCIZ /:[.,/]]
PUSHJ P,SIXINL
CAIE T1,","
JRST GFN0 ;WE HAVE FILENAME
TRNN T,77 ;ELSE RIGHT JUSTIFY
JRST [ LSH T,-6
JRST .-1]
JRST GPPN2 ;AND TREAT AS PPN
;; MLFLNM
MLFLNM: TLO FLG,MFNMF
PUSHJ P,GPPNX
;falls through
>;repeat 0
MLFLN1: JRST [MOVE D,T ;IF NO COMMA WAS FOUND, THAT'S
TLNN T,-1 ; OK, MAILING TO PROGRAMMER ONLY
JRST OKMF ; ELSE P OR PN WAS
POPJ P,] ;TOO LONG
OKMF: MOVSI C,'DSK'
MOVSI E,'MSG'
MOVE F,D
MOVE D,['2 2'] ;PERSON.MSG[2,2]
MOVEM F,MLDEST# ;SAVE PPN FOR HEADER ETC.
JRST CPOPJ1 ;SUCCESS RETURN
;⊗ GETDST MLNCOP MLNB MLNA MLNMIN MLNMOK PRELAY MLFILE MLNMFF MLNMF2 MLNMF0 TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX DSTHNM DSTHNX FOPEN FACTXT DORELA DORELU DORELC DORELF DOREHC DOREHE DORELH DORERR DORNUS DORNU2 HSTCHK HSTOK SCANUS SCANMX MLHOST MLHOSL MLHOS2 POP12J RECRLY RECRL2 RECRL3 RECRLP RECRL0 RECRLE RECOUT RECOU2 GET0E1 GET0E2 GET0E3 GET0E4 GET0E5 GET0E6 GET0E7 GET010 GET011 GET012 GET013 GET014 GET015 GET016 GET017 GET1E1 GET1E2 GET1E3 GET1E4 GET1E5 GET1E6 GET1E7 GET1E8 GET1E9 GET110 GET111 GET112 GET1ER GET0ER COPDOM COPHST COPHS2 COPHOK CHKSTR CHKST0 SKPSPC SKPSP0 SKPSPG SKPSGL
;NEW GETDST TO ACCEPT HUMAN BEING NAMES AND LOOK IN FACT.TXT
;Validate destination address
; PUSHJ P,GETDST
; <relaying requested>
; <syntax error> or <bad host name> (latter iff SYNCOD is negative)
; <unknown user>
; <valid-user return>
GETDST: SETZM SYNCOD# ;clear error code for possible syntax error
SETZM FWDING# ;FLAG NOT FORWARDING
SETZM DQUOT# ;flag not quoted dest yet
SETZM SAWQUO# ;haven't seen any quoting (for relay check)
SETZM PRCENT# ;haven't seen percent yet
PUSHJ P,SKPSPG ;START SCANNING HIS INPUT
MOVE B,[POINT 7,[ASCIZ/to:/]]
PUSHJ P,CHKSTR ;make sure starts with "to:"
JRST GET1E1 ;didn't, syntax error, skip return with error 1
PUSHJ P,SKPSGL ;skip spaces again
CAIE A,"<" ;> ;path must start with left bracket
JRST GET1E2 ;syntax error, skip return with error 2
PUSHJ P,SKPSPG ;skip spaces after left broket
MOVE B,[POINT 7,XRFBUF] ;set up BPT to
MOVEM B,XRFBBP ; force GETCH to save name in buffer
SETZM XRFBZZ ;clear any previous overflow
IDPB A,XRFBBP ;store first char (read by SKPSPG)
CAIA ;already have first char of name now
MLNCOP: PUSHJ P,GETCHR ;get rest of line into buffer (allows rescanning it)
CAIE A,12 ;loop till end of line
JRST MLNCOP
SETZB A,DISFIL# ;not distribution file so far
IDPB A,XRFBBP ;terminate string with null
SETZM XRFBBP ;stop copying name
MOVE A,[POINT 7,XRFBUF] ;start scanning at beginning
MOVEM A,XRRBBP ;set up rescan byte ptr
ILDB A,XRRBBP ;check first char for special
CAIE A,"@" ;maybe relaying request
JRST MLNA ;nope
MLNB: ILDB A,XRRBBP ;if so, it'll have a colon later
;might CAIN A,"," ;old SMTP version used comma instead of colon
;be ppn JRST GET0E3 ;unimplemented relaying requested
CAIE A,":"
JUMPN A,MLNB ;loop unless end of string
JUMPN A,DORELA ;relaying requested, direct return
MLNA: AOS (P) ;want to skip at least once (unless reach POP12J)
MOVE A,[POINT 7,XRFBUF] ;start scanning at beginning
MOVEM A,XRRBBP ;set up rescan byte ptr
IFN FTLFRM,< ;log FROM: line if mail has been relayed before here
LDB A,[POINT 7,REVPTH,6] ;first char of reverse path
CAIN A,"@" ;atsign means was relayed
PUSHJ P,RECRLY ;record previously relayed mail
>;IFN FTLFRM
ILDB A,XRRBBP
CAIN A,42 ;dest quoted?
JRST [ SETOM DQUOT ;yes, remember that
MOVEI A," "
DPB A,XRRBBP ;replace quote with a space (assume local mail)
SETOM SAWQUO ;remember that we've flush quote, in case of relay
ILDB A,XRRBBP ;and get first real char
JRST .+1]
CAIN A,"\" ;quoting character?
JRST [ MOVEI A," "
DPB A,XRRBBP ;flush quote char for MAIL's benefit
SETOM SAWQUO ;remember that we've flush quote, in case of relay
ILDB A,XRRBBP ;yes (maybe quoting file designation char)
JRST .+1]
CAIE A,"#"
CAIN A,":" ;DEST STARTS WITH COLON
SKIPA A,["#"] ;(GFNML WILL SAVE THE CHAR FOR LATER
CAIN A,"@" ; AND WE ACCEPT INDIRECT REQUESTS)
JRST MLFILE ; SO IT'S A FILE SPEC, parse it
MOVE B,[POINT 7,NBUFFR] ;OTHERWISE WE MUST ACCUMULATE HIS NAME
MOVEI C,0 ;CHAR COUNT
MLNMIN: CAIL A,"A" ;JUST TAKE ALPHAMERICS
CAILE A,"Z" ;NONE OF THIS FUNNY STRING STUFF
CAIN A,"-" ;ACCEPT HYPHEN FOR PSEUDO-MAILBOX
JRST MLNMOK
CAIL A,"a"
CAILE A,"z"
CAIN A,"." ;accept dot in mailbox name for relaying
JRST MLNMOK
CAIN A,"%" ;Accept % sign to specify relaying
JRST [
;Flush next two instructions when MAIL can accept dest like: User%Host1%Host2
;Flushing these two instructions will allow multiple percents in SMTP relaying.
SKIPE PRCENT ;no multiple percents yet (till MAIL takes 'em)
JRST GET0E2 ;indicate error, two or more percents
MOVEM B,PRCENT ;save output byte ptr
MOVE T,XRRBBP ;save input byte ptr
MOVEM T,PRCENX#
JRST MLNMOK] ;and keep scanning incase multiple percent-signs
CAIL A,"0" ;allow digits in mailbox name
CAILE A,"9"
JRST MLNMFF ;not valid mailbox address char, end of name
MLNMOK: IDPB A,B
ILDB A,XRRBBP
repeat 0,< ;this can't work because of the space it sticks in the middle
;of the destination name
CAIN A,"\" ;quoting character?
JRST [ MOVEI A," "
DPB A,XRRBBP ;flush quote char for MAIL's benefit
ILDB A,XRRBBP ;yes (maybe quoting file designation char)
JRST .+1]
>;repeat 0
SKIPN NBUFFX ;QUICK & DIRTY OFLO DETECTOR
AOJA C,MLNMIN
SETZM NBUFFX ;SO HE CAN TRY AGAIN
JRST UNRECU ;NAME UNRECOGNIZED IF TOO LONG
;% seen to indicate relaying. Skip return has already been set, will be
;undone if we are successful. Here after entire address has been scanned.
PRELAY: MOVEI T,0 ;terminate name in NBUFFR at last percent
IDPB T,PRCENT
MOVE T,PRCENX ;get input byte ptr
MOVEM T,XRRBBP ;restore byte ptr for scanning relay host name
PUSHJ P,SKPSPC ;skip blanks
PUSHJ P,COPHST ;get host name into DSTHNM
JRST GET0E6 ;host name too long
MOVE T,CLRBBP ;see where @ourhst started
CAME T,XRRBBP ;is that where relay host name ended?
JRST GET0E7 ;no, bad relay host syntax
MOVEI T,0
IDPB T,B ;terminate name in DSTHNM
PUSHJ P,HSTCHK ;see if we recognize host name
JRST [ SETOM SYNCOD ;bad host name
POPJ P,]
; PUSHJ P,SKPSP0 ;skip blanks
SOS (P) ;Yes, undo previous AOS (P)
POPJ P, ;And take relay-requested return
; SETOM PRCENT ;flag that we saw a %
; JRST MLNMF2 ;now parse our host name
MLFILE: PUSHJ P,GFNML ;scan distribution list filename, double skips
JRST GET0E4 ;bad syntax
JRST GET0E5 ;can't happen
LDB A,XRRBBP ;get last char read (delimiter)
CAIE A,"]" ;end of PPN?
JRST GET017 ;nope, lose (maybe was old format: @sail,user@host)
ILDB A,XRRBBP ;yes, get char after filename
JRST MLNMF2 ;filename OK, now parse rest of line (host)
;End of name. check for @SU-AI.ARPA (etc.).
;char delimiting name is in A, should be "@" (or ending quote)
MLNMFF: MOVEI T,0 ;delimit copy of name for TRYFOR
IDPB T,B ;terminate name in NBUFFR
MLNMF2: SKIPN DQUOT ;are we quoting?
JRST MLNMF0 ;no
CAIE A,42 ;yes, should see ending double quote
JRST GET016 ;but didn't
MOVEI A," "
DPB A,XRRBBP ;replace quote with a space (assume local mail)
PUSHJ P,SKPSPC ;yup, get real delimiter afer the quote
MLNMF0: MOVE T,XRRBBP ;byte pointer past end of name in XRFBUF
MOVEM T,CLRBBP# ;save for later (below)
movem a,saveda# ;save for debugging
PUSHJ P,SKPSP0 ;skip spaces after mailbox name
CAIE A,"@" ;name must be followed by "@" and host name
JRST GET0E6 ;syntax error -- no "@" where expected
PUSHJ P,SCANUS ;scan a host name, and make sure it's ours
JRST DORNU2 ;host name too long or isn't ours
;here if host name checked out OK as ours.
CAIE A,76 ;host name should be followed by right bracket
JRST GET011
PUSHJ P,SKPSPC ;name done, skip spaces after right bracket
JUMPN A,GET013 ;jump if junk at end of line -- syntax error
MOVEI T,0
DPB T,CLRBBP ;delimit main part of recipient address
JUMPN A,GET014 ;GOTTA END WITH NULL (CRLF flushed by GETCHR)
SKIPE DISFIL ;skip unless we went to GFNML
JRST CPOPJ2 ;OK, we win
JUMPE C,GET015 ;GOTTA HAVE SOME TEXT!
SKIPE PRCENT ;Was there a % for relaying?
JRST PRELAY ;yes, check it out
AOS (P) ;no more syntax error possibility
CAIG C,3 ;IF ≤3 CHARS STORED,
JRST HRPRIM ; TREAT AS JUST PRG (MAYBE WE'LL COME BACK)
MOVE A,[POINT 7,NBUFFR] ;INITIALIZE POINTERS
MOVEM A,FBPINI#
MOVE T2,[ILDB A,F]
MOVEM T2,FBPXCT#
PUSHJ P,TRYFOR ;TRY FORWARDING
JRST OKMF ;WIN
TRYFAC: OPEN .MFD,FOPEN ;OTHERWISE WE DO THE FACT.TXT THING
JRST [REPMES (451 System error, can't open disk to find user name.)]
MOVE C,['SPLSYS']
MOVEM C,FACTXT+3
LOOKUP .MFD,FACTXT
JRST NOFACT ;TROUBLE
SETZM FACCNT# ;COUNT MATCHES HERE
FACTLP: MOVE C,[POINT 6,B] ;READ A FACT.TXT ENTRY
MOVEI B,0 ;FIRST PRG IN SIXBIT
FACGE1: PUSHJ P,FACCHR ;GET DSK CHAR
JRST FACEOF
SUBI A,40
JUMPLE A,FACGE2
IDPB A,C
JRST FACGE1 ;CONTINUES TO TAB
FACGE2: MOVEM B,FACPRG#
MOVE B,[POINT 7,FACBUF]
MOVEM B,FACBPT#
FACGE3: PUSHJ P,FACCHR ;NOW COLLECT NAME
JRST FACEOF
IDPB A,B
CAIE A,12
JRST FACGE3
MOVEI A,0
IDPB A,B
FACWRD: MOVE B,[POINT 7,NBUFFR]
MOVEM B,FCSTBP# ;PREPARE TO START SCAN
FACTRY: ILDB A,FACBPT ;COMPARISON LOOP
ILDB B,FCSTBP
JUMPE B,FACTST ;USER'S NAME DONE, CHECK END OF FILE NAME
CAIL A,140 ;IGNORE CASE DIFFERENCES
SUBI A,40
CAIL B,140
SUBI B,40
CAIE B,(A)
JRST FACLUZ ;NOT THE SAME, SORRY
JRST FACTRY ;SAME, KEEP TRYING
FACTST: CAIE A,15 ;IF NEXT FILE CHAR IS DELIM
CAIN A,40 ; (COULD FLUSH 40 TO JUST MATCH LAST NAME)
SKIPA B,FACPRG ; THEN MATCH, TELL HIM
JRST FACLUZ
MOVEM B,FACPPN# ;AND SAVE FOR LATER
repeat 0,< ;SMTP doesn't allow multiple responses to cmds
PUSHJ P,IMPSTR
ASCIZ /050 /
PUSHJ P,SIXWRT ;PUT OUT PRG IN SIXBIT
PUSHJ P,IMPSTR
ASCIZ / is the ID for user /
MOVE E,[POINT 7,FACBUF]
PUSHJ P,ASCIIE ;GOOD GRIEF
>;repeat 0
AOS FACCNT ;COUNT MATCHES
JRST FACTLP ;GET NEXT FILE ENTRY
FACLUZ: CAIN A,15 ;NON-MATCH: IF AT END OF FILE ENTRY,
JRST FACTLP ; GET ANOTHER
CAIN A,40 ;IF AT END OF FILE WORD BUT NOT ENTRY,
JRST FACWRD ; KEEP SCANNING THIS ENTRY
ILDB A,FACBPT ;OTHERWISE SCAN THE FILE MORE
JRST FACLUZ
FACEOF: CLOSE .MFD, ;END OF FACT.TXT, LET IT GO
SKIPN C,FACCNT ;HOW MANY MATCHES?
JRST UNRECU ;NONE, NO SUCH USER
SOJN C,AMBIG ;TOO MANY
SKIPA D,FACPPN ;OK, GET THE PRG CODE
FACRGT: LSH D,-6
TRNN D,77 ;RIGHT ADJUST
JRST FACRGT
MOVEM D,MLDEST
JRST OKMF ;CONTINUE AS USUAL
FACCHR: SOSG MBUF+2
IN .MFD,
JRST FACCH1
STATO .MFD,20000
JRST NOFACT
RELEAS .MFD,
POPJ P,
FACCH1: ILDB A,MBUF+1
JUMPE A,FACCHR
JRST CPOPJ1
HRPRIM: MOVEI T1,12 ;FAKE DELIM OF LF
MOVEI T,0 ;ACCUMULATE RT-JUSTIFIED NAME
MOVE B,[POINT 7,NBUFFR] ; FROM TYPEIN
HRLOOP: ILDB A,B
JUMPE A,HRDONE
CAIL A,140
SUBI A,40
SUBI A,40
LSH T,6
IORI T,(A)
TLNN T,77
JRST HRLOOP
HRDONE: TLO FLG,MFNMF
PUSHJ P,GPPN2 ;FOOLS JUMP IN...
JRST MLFLN1 ;AND AGAIN
TRNE D,-1 ; (DON'T ASK. JUST DON'T ASK.)
PUSHJ P,FLUSCS
JRST OKMF ;AND AGAIN
NOFACT: PUSHJ P,IMPSTR
ASCIZ /451 Error reading user name file--mail aborted.
/]
RELEAS .MFD,
FACERR: POP P,A ;POP RET ADDR TO THWART OLD ERROR MSG AND FLUSCS
POPJ P,
UNRECU: PUSHJ P,IMPSTR
ASCIZ /550 I don't know anybody named /
ifn verbose,<
outstr nbuffr
>;ifn verbose
MOVE E,[POINT 7,NBUFFR]
PUSHJ P,ASCIIE
PUSHJ P,IMPSTR
ASCIZ /
/]
JRST FACERR
AMBIG: PUSHJ P,IMPSTR
ASCIZ /550 Ambiguous name rejected, matches multiple users
/]
JRST FACERR
FACBUF: BLOCK 20 ;BUFFER FOR FACT.TXT NAME
NBUFFR: BLOCK 1+MAXPTH/5 ;BUFFER FOR TYPED-IN NAME (recipient path name)
NBUFFX: 0 ;BECOMES NONZERO ON OVERFLOW
DSTHNM: BLOCK 1+MAXPTH/5 ;buffer for host name
DSTHNX: 0 ;overflow detector for host name
FOPEN: 0
SIXBIT /DSK/
XWD 0,MBUF
FACTXT: SIXBIT /FACT/
SIXBIT /TXT/
0
SIXBIT /SPLSYS/
;Here to parse an explicit mail relay request for RCPT TO: command.
;Expected syntax is <@SAIL,@HOST1,@HOST2,...,@HOSTn:user@HOSTm>.
;Scan a host name (to colon or comma) and see if we found
;our own hostname (if not, error).
;If char is colon, then dest string for mail is everything after colon
;(user@HOSTm), although we must verify HOSTm as a known host.
;If char is comma, then should be followed by "@" and next host name; scan
;host name for known host. Host name should be followed by comma or colon;
;dest string for mail is:
; ↓:everything.after.hostname.including.comma.or.colon↓%hostname
DORELA: MOVE A,[POINT 7,XRFBUF] ;start scanning at beginning
MOVEM A,XRRBBP ;set up rescan byte ptr
ILDB A,XRRBBP ;check first char for special
CAIE A,"@" ;must be atsign (was last time we looked)
JRST GET1E3 ;impossible error
PUSHJ P,SCANUS ;scan a host name, and make sure it's ours
JRST DORNUS ;host name too long or isn't ours
CAIN A,":" ;colon now means next text is user@hostm
JRST DORELU ;process @sail:user@hostm
CAIE A,"," ;otherwise better be comma
JRST GET1E4 ;bad syntax
PUSHJ P,SKPSPC ;get another @ after comma
CAIE A,"@" ;better be one
JRST GET1E5 ;oops, syntax error
PUSHJ P,SKPSPC ;skip spaces again
PUSHJ P,COPHST ;get host name into DSTHNM
JRST GET1E6 ;host name too long
MOVEI T,0
IDPB T,B ;terminate name in DSTHNM
PUSHJ P,HSTCHK ;see if we recognize host name
JRST DORERR ;bad host name, restore ACs and take error return
;now we've verified that the host we have to relay on to is known to us
PUSHJ P,SKPSP0 ;skip spaces around host name
CAIE A,":" ;host name must be followed by one of
CAIN A,"," ; these two chars
CAIA ;OK
JRST GET1E7 ;but it isn't!
SKIPA C,[76] ;terminator to check for is right bracket
DORELU: MOVEI C,"@" ;terminate copy on atsign
;output .FTP file to record relay event by mailing msg to MAIL-RELAY-LOG/-H
;Text of entry is: MAIL MAIL-RELAY-LOG/-H<crlf><ff>
; date/time, remote host initiating, mail sender, mail dest.
;sender is in REVPTH
;dest is in XRFBUF
PUSH P,A ;preserve indicator characters
PUSH P,C
PUSHJ P,RECRLY ;record relay in .FTP file
POP P,C
POP P,A
MOVE B,[POINT 7,XRFBUF] ;set up BPT to move name to front of buffer
MOVEI T,"↓" ;quote the whole string to MAIL
IDPB T,B
CAIE C,"@" ;skip if only one more host, final relay
IDPB A,B ;insert colon or comma for SMTP relaying
MOVEI T,0 ;no right bracket yet
DORELC: ILDB A,XRRBBP ;move rest of forwarding path to front of buf
IDPB A,B ;can't overflow, since didn't before (same buf)
CAIN A,(C) ;find last right bracket or atsign
MOVE T,B ;save byte ptr to last right bracket/atsign
JUMPN A,DORELC ;loop to end of path (null)
JUMPE T,GET1E8 ;no right bracket seen!
MOVEI A,"↓" ;end quoted string for MAIL
DPB A,T ;overwrite bracket with quoter
CAIN C,"@" ;if here via DORELU, scan host name now
JRST DORELH ;go copy host name into DSTHNM and verify it
DORELF: MOVEI A,"%"
IDPB A,T ;signal remote host to MAIL
SKIPA B,[POINT 7,DSTHNM] ;byte ptr to host name
DOREHC: IDPB A,T
SKIPE XRFBZZ ;check for overflow
JRST GET1E9 ;ovrfl: unlikely, it all came out of same buffer
ILDB A,B ;copy destination host name for MAIL
JUMPN A,DOREHC ;loop till the final null
JUMPE C,CPOPJ ;jump if came via DORELH -- no /-E needed
MOVE B,[POINT 7,[ASCIZ $/-E$]] ;add switch to indicate relaying to MAIL
DOREHE: ILDB A,B
IDPB A,T ;(even allow overflow into XRFBZZ!)
JUMPN A,DOREHE ;loop till copied the final null
POPJ P, ;destination string now ready in XRFBUF
;Byte ptr to output string for MAIL dest is now in T. Must not clobber it.
DORELH: MOVEM T,XRRBBP ;set up byte ptr to scan host name now
PUSHJ P,SKPSPC ;skip spaces around host name
PUSHJ P,COPHST ;get host name into DSTHNM
JRST GET1E6 ;host name too long
MOVEI C,0
IDPB C,B ;terminate name in DSTHNM
PUSHJ P,HSTCHK ;see if we recognize host name
JRST DORERR ;bad host name, restore ACs and take error return
;now we've verified that the host we have to relay on to is known to us
PUSHJ P,SKPSP0 ;skip spaces around host name
CAIE A,76 ;host name must be followed by right bracket
JRST GET112 ;oops
JRST DORELF ;now copy host name into string for MAIL (via T)
;here if unrecognized host name, flag it and take same error return as syntax err
DORERR: SETOM SYNCOD ;negative error code means unknown host
JRST CPOPJ1 ;take skip return for unknown host
;here if host name given isn't ours; flag it, take same error return as syntax err.
;enter at DORNU2 if return addr already has been AOS'd.
DORNUS: AOS (P) ;skip return for bad host
DORNU2: MOVNI E,2 ;-2 flags host name as not ours when it should be
MOVEM E,SYNCOD ;negative error code means bad host name
POPJ P,
;routine to skip iff host name in DSTHNM is known to us. preserves all ACs.
HSTCHK: MOVEM 11,1+11(P) ;save ACs (NETWRK clobbers 0:11)
MOVEI 11,1(P) ;source,,dest of BLT from ACs
BLT 11,1+10(P) ;save only those NETWRK says it clobbers
ADJSP P,12 ;fix stack
MOVEI 0,DSTHNM ;ptr to host name to look up
IFN FTMUSF,<
MOVE 1,DSTHNM
AND 1,[BYTE (7) 137,137,137,137,137]
CAMN 1,[ASCII/CCRMA/]
JRST HSTOK ;special kludge for CCRMA (copied from MAIL)
>;IFN FTMUSF
PUSHJ P,HSTNAM ;check host name
SOSA -12(P) ;no such host, take error return
SOS -12(P) ;ambiguous host, take error return
HSTOK: MOVSI 11,-11(P) ;source,,dest of BLT to ACs
BLT 11,11 ;restore ACs 0:11
ADJSP P,-12 ;back up the stack ptr
JRST CPOPJ1 ;assume success (unless HSTNAM failed)
;Scan buffer for a host name, and see if it is ours
;Direct return if name too long or isn't ours.
;Skip if host name is ours.
SCANUS: PUSHJ P,SKPSPC ;skip spaces after "@"
PUSHJ P,COPHST ;copy host name to special block
POPJ P, ;host name too long
MOVEI T,0
IDPB T,B ;terminate name in DSTHNM
repeat 0,< ;now include domain in name
SCANMX: CAIN A,"." ;is a domain coming?
JRST [ ILDB A,XRRBBP
PUSHJ P,COPDOM ;yes, skip over domain name
POPJ P, ;host name (sic) was too long -- can't happen
JRST SCANMX ] ;and then look for another domain
>;repeat 0
PUSHJ P,SKPSP0 ;skip spaces around host name
MOVEM 11,1+11(P) ;save ACs (NETWRK clobbers 0:11)
MOVEI 11,1(P) ;source,,dest of BLT from ACs
BLT 11,1+10(P) ;save only those NETWRK says it clobbers
ADJSP P,12 ;fix stack
MOVEI 0,DSTHNM ;ptr to host name to look up
PUSHJ P,HSTNAM ;check host name
JRST POP12J ;no such host, restore ACs and take error return
JRST POP12J ;ambiguous host, restore ACs and take error return
MLHOST: MOVE 1,[-LOURH3,,OURH3] ;aobjn ptr to list of our host nbrs
MLHOSL: CAMN 0,(1) ;is this one of our host nbrs?
JRST [ AOS -12(P) ;host name was OK, it's ours, success return
JRST POP12J] ;restore ACs and win
AOBJN 1,MLHOSL ;no, check other numbers
MLHOS2: PUSHJ P,HSTNXA ;get next host address for name given earlier
JRST POP12J ;none, lose
JUMPN 0,MLHOST ;if non-zero, then try it out
POP12J: MOVSI 11,-11(P) ;source,,dest of BLT to ACs
BLT 11,11 ;restore ACs 0:11
ADJSP P,-12 ;back up the stack ptr
POPJ P, ;host name isn't ours
;Open .FTP file and write a log entry for relayed mail
;Note that any file opened here is closed at QUIT.
RECRLY: PUSH P,OUTINSTR ;preserve whatever there is
MOVE D,[PUSHJ P,RECOUT] ;instruction to output char to event log mailer
MOVEM D,OUTINSTR
AOSE RECOPN ;skip if file not open already
JRST RECRL3 ;already done first part
INIT RLY,200 ;open device
'DSK '
ROBUF,,0 ;output buffer hdr
JRST RECRLE ;lose
RECRL2: PUSHJ P,SETMFR ;get filename for .FTP file in RMDFIL
MOVEM D,RMDFIL+3 ;store PPN
ENTER RLY,RMDFIL ;create .FTP file for relay log entry
JRST RECRL0 ;failed, see why, maybe retry
PUSH P,JOBFF
MOVEI B,RLYOBF
MOVEM B,JOBFF
OUTBUF RLY,2 ;two buffers should be plenty
POP P,JOBFF
MOVEI B,[ASCIZ $MAIL/-H MAIL-RELAY-LOG
$]
PUSHJ P,WRTSTR ;start file with above string
MOVEI A,14 ;a formfeed ends cmd page for MAIL
XCT OUTINSTR
RECRL3: PUSHJ P,DATGEN ;output date to log entry
MOVEI B,[ASCIZ/ relay from /]
PUSHJ P,WRTSTR
MOVEI B,HSTSTR ;pointer to host name
PUSHJ P,WRTSTR ;say whom mail came to us from
MOVEI B,[ASCIZ/
mail from:</]
PUSHJ P,WRTSTR
MOVEI B,REVPTH
PUSHJ P,WRTSTR ;output rest of MAIL FROM: line
MOVEI B,[ASCIZ/>
rcpt to:</] ;>;matching bracket
PUSHJ P,WRTSTR
MOVEI B,XRFBUF
PUSHJ P,WRTSTR ;output rest of RCPT TO: line
MOVEI B,RCDCR ;output CRLF
PUSHJ P,WRTSTR
RECRLP: POP P,OUTINSTR ;restore whatever was here before
POPJ P,
RECRL0: HRRZ B,RMDFIL+1 ;get error code
CAIN B,3 ;busy file?
JRST RECRL2 ;yes, try another filename
RECRLE: SETOM RECOPN ;some strange error, give up
JRST RECRLP
RECOUT: SOSG ROBUF+2
OUT RLY,
JRST RECOU2
OUTSTR [ASCIZ/OUT uuo failed for RLY channel, aborting mail relay log entry.
/]
MOVSI A,(<JFCL>)
MOVEM A,OUTINSTR ;make sure we don't try any more
RELEAS RLY,
SETOM RECOPN ;no longer open
POPJ P,
RECOU2: IDPB A,ROBUF+1
POPJ P,
GET0E1: JSP T,GET0ER ;set error code and take direct return
GET0E2: JSP T,GET0ER
GET0E3: JSP T,GET0ER
GET0E4: JSP T,GET0ER
GET0E5: JSP T,GET0ER
GET0E6: JSP T,[ JUMPN A,GET0ER ;give error to foreign mailer unless have a null
repeat 0,< ;bug fixed -- don't halt -- this is foreign mailer's real syntax error
INTMSK [0] ;disable interrupts for now (connection may die...)
PUSH P,T
MOVE T,['GET ME']
SETNAM T, ;change our name to attract attention
POP P,T
HALT $.+1
INTMSK [-1] ;re-enable after continuing
>;repeat 0
JRST GET0ER ]
GET0E7: JSP T,GET0ER
GET010: JSP T,GET0ER
GET011: JSP T,GET0ER
GET012: JSP T,GET0ER
GET013: JSP T,GET0ER
GET014: JSP T,GET0ER
GET015: JSP T,GET0ER
GET016: JSP T,GET0ER
GET017: JSP T,GET0ER
GET1E1: JSP T,GET1ER ;set error code and take skip return
GET1E2: JSP T,GET1ER
GET1E3: JSP T,GET1ER
GET1E4: JSP T,GET1ER
GET1E5: JSP T,GET1ER
GET1E6: JSP T,GET1ER
GET1E7: JSP T,GET1ER
GET1E8: JSP T,GET1ER
GET1E9: JSP T,GET1ER
GET110: JSP T,GET1ER
GET111: JSP T,GET1ER
GET112: JSP T,GET1ER
GET1ER: AOS (P) ;set skip return and then store error code
SUBI T,GET1E1-GET0E1 ;adjust PC to other table
GET0ER: MOVSI T,-GET0E1(T) ;calculate syntax error code
HRRI T,(A) ;include last character (or whatever) in code
MOVEM T,SYNCOD ;store for error reply
POPJ P,
;discard domain name, skip on success (always, unless host name already too long)
COPDOM: TDZA B,B ;don't save output -- discard domain name
;copy host name to DSTHNM, skip on success, no-skip on name too long
COPHST: MOVE B,[POINT 7,DSTHNM] ;byte ptr for saving destination host name
COPHS2: CAIL A,"A" ;JUST TAKE ALPHAMERICS and dash
CAILE A,"Z" ;NONE OF THIS FUNNY STRING STUFF
CAIN A,"-" ;ACCEPT HYPHEN FOR PSEUDO-MAILBOX or host
JRST COPHOK
CAIL A,"a"
CAILE A,"z"
CAIN A,"." ;allow dot in host name for domain
JRST COPHOK
CAIL A,"0" ;allow digits in names
CAILE A,"9"
JRST CPOPJ1 ;end of name -- not letter, digit or hyphen
COPHOK: IDPB A,B
ILDB A,XRRBBP
SKIPN DSTHNX ;QUICK & DIRTY OFLO DETECTOR
JRST COPHS2 ;no overflow, keep scanning
SETZM DSTHNX ;clear overflow flag
POPJ P, ;NAME TOO LONG, error return
;compare input string against a constant. skip if OK. ignore case.
;B points to constant. call with A containing first char already.
CHKSTR: ILDB C,B
JUMPE C,CPOPJ1 ;skip if end of constant
CAIN C,(A)
JRST CHKST0 ;OK so far
CAIL C,"A" ;maybe letter of different case
CAILE C,"z"
POPJ P, ;different chars, lose
CAILE C,"Z"
CAIL C,"A"
TRC C,40 ;invert case of constant string's letter
CAIE C,(A)
POPJ P, ;different chars
CHKST0: PUSHJ P,GETCHR ;next input char
JRST CHKSTR ;loop
SKPSPC: ILDB A,XRRBBP
SKPSP0: CAIE A,40 ; SKIPPING IRRELEVANCIES
CAIN A,11
JRST SKPSPC
POPJ P,
SKPSPG: PUSHJ P,GETCHR
SKPSGL: CAIE A,40 ; SKIPPING IRRELEVANCIES
CAIN A,11
JRST SKPSPG
POPJ P,
;TRYFOR TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT
;TRYFOR FORWARDING
FF←←14
CR←←15
LF←←12
TAB←←11
TRYFOR:
repeat 0,<
SKIPE XRFBBP ;Doing XRCP R scheme?
JRST TRYFO0 ;Yes, accept forwarding.
TRNN FLG,.MAIL
JRST CPOPJ1 ;NO FORWARDING EXCEPT FOR MAIL CMD
TRYFO0:
>;repeat 0
MOVEM B,FORB#
MOVEM C,FORC#
MOVEM D,FORD#
MOVEM E,FORE#
MOVEM F,FORF#
OPEN .MFD,FOPEN
JRST [REPMES (451 System error, can't open disk to find user name.)]
MOVE C,['MAISYS']
MOVEM C,FORTXT+3
LOOKUP .MFD,FORTXT
JRST NOFACT ;TROUBLE
PUSHJ P,FORCHG ;CHECK FOR E DIRECTORY
MOVE T1,MBUF+1
MOVE T2,(T1)
CAME T2,[ASCII /COMME/]
JRST FORLIN
MOVE T2,1(T1)
CAME T2,[ASCII /NT ⊗ /]
JRST FORLIN
MOVE T2,2(T1)
CAME T2,[ASCII / VAL/]
CAMN T2,[ASCII /INVAL/]
JRST TRYFO1
JRST FORLIN
TRYFO1: PUSHJ P,FORCHG
JUMPE A,FORLIN
CAIE A,FF
JRST TRYFO1
PUSHJ P,FORCHG
FORLIN: MOVE F,FBPINI ;NEW LINE OF FILE, REREAD THE USER'S STRING
FORCHR: JUMPE A,FORZIP ;FORMAT ERROR, EOF IN MID-LINE
CAIN A,LF
JRST FORZIP ;FORMAT ERROR, LINE ENDS W/O TAB
CAIN A,TAB
JRST FOTAB ;END OF STRING IN FILE
PUSH P,A
XCT FBPXCT ;ELSE GET A CHAR FROM USER'S STRING
POP P,T1
CAIL T1,140
SUBI T1,40
CAIL A,140
SUBI A,40 ;LC TO UC
CAIE T1,(A) ;MATCH THE FILE?
JRST FORNO ;NO, GO TO NEXT LINE
PUSHJ P,FORCHG ;READ CHAR FROM FORWRD.TXT
JRST FORCHR
FORNO: PUSHJ P,FORCHG ;SKIP TO END OF LINE
JUMPE A,FORZIP
CAIE A,LF
JRST FORNO
PUSHJ P,FORCHG ;BEGINNING OF NEXT LINE
JUMPE A,FORZIP ;DONE IF DONE
JRST FORLIN ;ELSE CHECK OUT THIS LINE
FORTEL: AOJN C,FORCPY ;JUMP IF NOT FIRST GRITCH
repeat 0,< ;no multiple responses in smtp
PUSHJ P,IMPSTR
ASCIZ /050 Mail for /
PUSH P,F
MOVE F,FBPINI
FORTE1: XCT FBPXCT ;COPY THE FORWARDEE
JUMPE A,FORTE2
PUSHJ P,PUTCH1
JRST FORTE1
FORTE2: PUSHJ P,IMPSTR
ASCIZ / will be forwarded to /
POP P,F
>;repeat 0
JRST FORCPY
FOTAB: XCT FBPXCT ;END OF FILE STRING. END OF USER STRING TOO?
JUMPN A,FORNO ;NO, NOT A MATCH
MOVNI C,1 ;FLAG FOR INFORMING THE REMOTE END
FORCPY: PUSHJ P,FORCHG ;COPY A CHAR
CAIE A,CR
CAIN A,LF
MOVEI A,0 ;SIMULATE EOF ON EOL
CAIN A,"⊗"
JRST FORTEL ;GRITCH MEANS TELL ABOUT THE FORWARDING
JUMPL C,FORCP1 ;JUMP IF NOT NOTIFYING
CAIN A,"%"
MOVEI A,"@" ;USE OFFICIAL NETWORK FORMAT (SIGH...)
;; PUSHJ P,PUTCH1
FORCP1: JUMPN A,FORCPY ;CONTINUE IF NOT DONE
JUMPL C,FORCP2
;; PUSHJ P,IMPCR
FORCP2: SETOM FWDING ;FLAG FORWARDING
CLOSE .MFD,
POPJ P, ;SUCCESS RETURN
FORZIP: CLOSE .MFD,
MOVE B,FORB#
MOVE C,FORC#
MOVE D,FORD#
MOVE E,FORE#
MOVE F,FORF#
JRST CPOPJ1 ;FAILURE RETURN
FORCHG: PUSHJ P,FACCHR
MOVEI A,0
POPJ P,
FORTXT: SIXBIT /FORWRD/
SIXBIT /TXT/
0
SIXBIT /MAISYS/
;DIROUT DIROU1 DIROU2 DIRO25 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOFL DIEOF0 DIEOF1 DIFINI DIEOML DIMLFL DIERR3
repeat 0,< ;whole page
;; DI ROUTINE - GET DATA FROM IMP, STORE IN WAITS FILE SYSTEM
;; ENVIRONMENTAL PREQUISITES FOR CALLING DIROUT:
;; 1) WAITS FILE SYSTEM IS INITIALIZED, AND HAS BEEN
;; "ENTERED". THE DI ROUTINE WILL STORE THE FILE IN WAITS
;; FILE SYSTEM USING BUFFER HEADER "FIBUF".
;; 2) C(DIMODE) INDICATES MODE OF DATA TRANSFER
;; 4) C(DITYPE) INDICATES TYPE OF DATA (ARPANET FTP CONVENTIONS)
;; 5) C(FOTYPE) INDICATES MOVE OF DATA TRANSFER (LOCAL TO
;; WAITS, THIS INDICATES THE WAY OF HANDLING "FIBUF" BUFFER).
;; WHAT DI ROUTINE DOES:
;; 1) INITS THE IMP, ON CHANNEL DIMP.
;; 2) ESTABLISHES DATA CONNECTION WITH FOREIGN USER TELNET.
;; 3) ACCEPTS DATA FROM IMP, STUFFING IT INTO WAITS FILE
;; SYSTEM.
;; 4) CLOSES DATA CONNECTION AND RELEASES WAITS FILE SYSTEM
;; UPON ANY OF THE FOLLOWING:
;; A) DATA CONNECTION CLOSED FOR ANY REASON
;; B) EOF ARRIVES ON DATA CONNECTION
;; C) "DIABORT" FLAG IS FOUND TO BE SET
;; D) ERROR IN WAITS FILE SYSTEM
DIROUT: MOVEI B,1 ;INDICATE DATA DIRECTION "IN"
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST ICONER ;ERROR
;;# DCS 10-15-72 ADD FTP START RESPONSE HERE PER CMU REQUEST
MOVEI A,DIMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
MOVE E,[POINT 7,[ASCIZ /250 Socket to me!
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
;;# DCS
MOVNI FLG2,1
TLO FLG,MEOFBT
MOVE B,[JRST CPOPJ2] ;MOST DATA MODES RETURN SUCCESSFUL WITH ANY BYTE
MOVE A,DIMODE ; BUT TEXT MODE MUST DO AN EOF TEST FIRST
CAIN A,2 ;ARE WE DOING TEXT MODE TRANSFER?
MOVE B,[JRST GETDAE] ; YES, SPECIAL GLITCH
MOVEM B,GETDA0 ;PLANT RETURN INSTRUCTION
DIROU1: HRROI C,-40
DIROU2: PUSHJ P,GETDAT ;C(A) ← BYTE OF DATA FROM IMP
JRST DIERR3 ; FAILURE RETURN
JRST DIEOF9 ; EOF RETURN
SKIPN EOFMAI
JRST DIROU3
AOJN FLG2,DIRO25
IFN FTFRM,<
PUSHJ P,MFRINI ;"FROM" LINE FINDER LINE INIT
>;IFN FTFRM
IFN FTMSJ,<
PUSHJ P,MSJINI ;"SUBJECT" LINE FINDER LINE INIT
>;IFN FTMSJ
JRST DIROU3
DIRO25:
IFN FTFRM,<
PUSHJ P,MFRCHR ;"FROM" LINE FINDER CHAR SCANNER
>;IFN FTFRM
IFN FTMSJ,<
PUSHJ P,MSJCHR ;"SUBJECT" LINE FINDER CHAR SCANNER
>;IFN FTMSJ
DIROU3:
IFN %XRCP,<
SKIPE XRBPTR
JRST [ PUSHJ P,XRCHO
JRST .+3] ; Bypass PUTFIL & err return.
>
PUSHJ P,PUTFIL
JRST DIERR2
CAIN A,12
MOVNI FLG2,1
AOJL C,DIROU2
PUSHJ P,SXACTV
PUSHJ P,DIWAIT
JRST DIROU1
DIERR: PUSHJ P,DIMPSTR
ASCIZ /452 STOR incomplete, data connection closed early.
/
JRST DIER2A
ICONER: PUSHJ P,DIMPSTR
ASCIZ /454 STOR incomplete, can't connect to your data socket
/
JRST DIER2A
DIERR2: PUSHJ P,DIMPSTR
ASCIZ /453 STOR incomplete, local file system error
/
DIER2A: SETZM EOFMAI ;ERROR. FORGET ABOUT SPECIAL MAIL STUFF
IFN %XRCP,<
SKIPE XRBPTR
JRST [ PUSHJ P,XRSRST
JRST DIFINI]
>
RELEAS FIMP,3 ; BECAUSE WE ARE FLUSHING THE OUTPUT HERE
JRST DIFINI
DIEOF9: SKIPN EOFMAI
JRST DIEOF
IFN %XRCP,<
SKIPE XRBPTR
JRST [ PUSHJ P,XRSSET ; Finalize saved text stuff.
PUSHJ P,DIMPSTR
ASCIZ /252 Text saved.
/
JRST DIFINI]
>
USETO FIMP,1 ;BACK UP TO WHERE THE COMMAND BELONGS
PUSHJ P,WRHDR
DIEOF: MOVE A,DITYPE ;SPECIAL EOF FOR IMAGE TYPE
SOJN A,DIEOFQ ;ELSE JUST CLOSE EVERYTHING
MOVE A,FIWORD ;GET LAST PARTIAL WORD
PUSHJ P,PUTFI0
JFCL ;NEVER MIND ERROR, TOO LATE
DIEOFQ: RELEASE FIMP,
SKIPN EOFMAI
JRST DIEOF1
MOVEI A,RMDWAK
WAKEME A,
JFCL
REPEAT 0,<
MOVE A,DITYPE
MOVE A,FMODES(A)
MOVEM A,OMLOPN
OPEN .OLD,OMLOPN
JRST DIEOF0
PUSH P,JOBFF
MOVEI A,OLDIBF
MOVEM A,JOBFF
INBUF .OLD,2
POP P,JOBFF
LOOKUP .OLD,OMLNAM
JRST DIEOF0
DIEOFL: PUSHJ P,OMLGET ;COPY REST OF FILE
JRST DIEOF0 ; EOF RETURN
PUSHJ P,OMLOUT
JRST DIEOFL
DIEOF0: RELEAS .OLD,
PUSHJ P,SEND ;MLFL, NOTIFY RECIPIENT
>;REPEAT 0
DIEOF1: JUMPL FLG,DIEOML
PUSHJ P,DIMPSTR
ASCIZ /252 Finis; /
PUSHJ P,ERRFN
PUSHJ P,DIMPSTR
ASCIZ/
/
DIFINI: SETZM DIACTV
RELEASE DIMP,
SKIPN QUITNG ;IF TRIED TO QUIT, TRY
POPJ P, ; AGAIN (MULTIPLE-SUICIDE MODE)
JRST BYE1
DIEOML: TRNN FLG,17 ;WAS THIS A MAIL&FRIENDS COMMAND, OR MLFL?
JRST DIMLFL ;MLFL -- succeeds with different code
PUSHJ P,DIMPSTR
ASCIZ /256 Thanks for the blurb
/
JRST DIFINI
DIMLFL: PUSHJ P,DIMPSTR
ASCIZ /252 Thanks for the blurb
/
JRST DIFINI
DIERR3: PUSHJ P,DIMPSTR
ASCIZ /452 STOR incomplete, error reading data connection
/
JRST DIER2A
>;repeat 0
;RMDWAK RMDSYS OMLGET OMLGT1 OMLOUT OMLOPN OMLBUF OMLNAM PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
RMDWAK: '<RMND>'
RMDSYS: 'RMDSYS'
0
repeat 0,< ;rest of page
OMLGET: SOSG OMLBUF+2
IN .OLD,
JRST OMLGT1
STATO .OLD,20000
JRST DIERR2
POPJ P, ;EOF
OMLGT1: ILDB A,OMLBUF+1
JUMPE A,OMLGET
JRST CPOPJ1
OMLOUT: SOSG FIBUF+2 ;ROOM IN BUFFER?
OUT FIMP, ; NO, DO AN OUTPUT
CAIA
JRST DIERR2 ; OUTPUT FAILS
IDPB A,FIBUF+1 ;STUFF DATA BYTE INTO BUFFER
POPJ P,
OMLOPN: 0
SIXBIT /DSK/
XWD 0,OMLBUF
OMLBUF: BLOCK 3
OMLNAM: 0
SIXBIT /MSG/
0
SIXBIT / 2 2/
;; CALL: MOVE A,<BYTE TO GO INTO LOCAL FILE SYSTEM>
;; PUSHJ P,PUTFIL
;; ERROR RETURN
;; NORMAL RETURN
PUTFIL: MOVE B,DITYPE ;PROCESSING DEPENDS ON TYPE
JRST .+1(B) ;DISPATCH
JRST PUTFI2 ;ASCII, DO CHAR TRANSLATION
JRST PUTFI3 ;IMAGE, HAIRY CROCK. ELSE LOCAL BYTE
PUTFI0: SOSG FIBUF+2 ;ROOM IN BUFFER FOR THIS BYTE?
OUT FIMP, ; NO, OUTPUT THE BUFFER
JRST PUTFI1 ;ROOM IN BUFFER, OR SUCCESSFUL OUTPUT
POPJ P, ; ERROR RETURN
PUTFI1: IDPB A,FIBUF+1 ;PUT BYTE INTO BUFFER
JRST CPOPJ1 ;SUCCESS RETURN
PUTFI2: JUMPE A,CPOPJ1 ;ASCII, IGNORE NULLS,
CAIL A,200
JRST CPOPJ1 ; IGNORE FUNNY NVT CODES,
CAIN A,176 ; AND TRANSLATE FUNNY CHARS
MOVEI A,32 ;TILDE
CAIN A,175
MOVEI A,176 ;RIGHT BRACE
CAIN A,33
MOVEI A,175 ;ALTMODE
JRST PUTFI0 ;NOW NORMAL IO STUFF
PUTFI3: SKIPE B,FIBTSL ;HAIRY IMAGE MODE WRAPAROUND BYTE CROCK
JRST PUTFI4
EXCH A,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVE A,FIWORD
SETZM FIWORD
MOVS B,DIBS
LSH B,6
IOR B,[POINT 0,FIWORD]
MOVEM B,FIBPT
MOVEI B,=36
PUTFI4: SUB B,DIBS
MOVEM B,FIBTSL
JUMPL B,PUTFI5
IDPB A,FIBPT
JRST CPOPJ1
PUTFI5: MOVEI B,0
MOVE D,FIBTSL
LSHC A,(D) ;POSITION THE NEW BYTE
IOR A,FIWORD
MOVEM B,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVEI A,=36
ADDB A,FIBTSL
LSH A,6 ;MAKING NEW BPT
ADD A,DIBS
LSH A,=24
HRRI A,FIWORD
MOVEM A,FIBPT
JRST CPOPJ1
FIBTSL: 0
FIWORD: 0
FIBPT: 0
>;repeat 0
;GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE
repeat 0,<
;; GETDAT - GET DATA BYTE FROM IMP DATA CONNECTION
;; CALL: PUSHJ P,GETDAT
;; RETURN HERE, ERROR
;; RETURN HERE, EOF
;; RETURN HERE, C(A) = DTAT BYTE
GETDAT: SOSG DIBUF+2 ;BYTE IN BUFFER?
JRST GETDA2 ; NO, THINK ABOUT DOING AN INPUT
GETDA1: ILDB A,DIBUF+1 ;GET THE DATA BYTE
GETDA0: 000 ; [JRST CPOPJ2] OR [JRST GETDAE]
GETDA2: PUSH P,B ;GET AN ACCUMULATOR TO PLAY WITH
HRRZ B,DIBUF ;GET POINTER TO BUFFER
HRRZ B,(B) ;GET POINTER TO NEXT BUFFER
SKIPGE (B) ;IS THERE DATA IN THAT BUFFER?
JRST GETDA3 ; YES, DO AN INPUT
INTOFF ;TURN OFF INTERRUPTS
MTAPE DIMP,[10] ;INPUT DATA WAITING IN FREE STORAGE?
JRST GETDA4 ; NO
INTON
GETDA3: POP P,B
IN DIMP,
JRST GETDA1 ;SUCCESSFUL INPUT
POPJ P, ;ERROR ON INPUT, GIVE ERROR RETURN
GETDA4: INTON ;TURN ON INTERRUPTS
POP P,B
MTAPE DIMP,GETDA7 ;GET STATUS OF CONNECTION
MOVE A,GETDA7+2 ;GET STATUS BITS
TLNE A,CLS ;IS SOMEBODY CLOSING THIS CONNECTION?
JRST GETDAC ; YES
GETDA5: PUSHJ P,DIWAIT ;WAIT FOR AWHILE, ...
JRST GETDA2 ; ... AND TRY AGAIN
GETDA7: 2 ↔ 0 ↔ 0 ;DATA BLOCK FOR MTAPE UUO
GETDAC: MOVE A,DIMODE ;ARRIVE HERE IF DI CONNECTION COSES
JRST .+1(A) ;DISPATCH ACCORDING TO CONNECTION MODE
JRST CPOPJ1 ;STREAM MODE, GIVE EOF RETURN
000 ;BLOCK MODE, UNIMPLEMENTED
POPJ P, ;TEXT MODE, GIVE ERROR RETURN
000 ;HASP MODE, UNIMPLEMENTED
GETDAE: CAIE A,301 ;ARRIVE HERE WITH BYTE IF DI CONNECTION IS
JRST CPOPJ2 ; TEXT MODE, GIVE NORMAL RETURN HERE.
JRST CPOPJ1 ; UNLESS EOF, GIVE EOF RETURN HERE.
>;repeat 0
;DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR OCONER
repeat 0,<
;; DOROUT - GET DATA FROM LOCAL FILE SYSTEM, TRANSMIT TO IMP
;; ENVIRONMENTAL PREREQUISITES FOR CALLING DOROUT:
;; 1) WAITS FILE SYSTEM IS INIT'ED, AND LOOKUP HAS BEEN
;; DONE. DOROUT WILL RETRIEVE THE FILE USING BUFFER
;; HEADER "FOBUF".
;; 2) C(DOMODE) INDICATES MODE OF DATA TRANSFER.
;; 3) C(DOTYPE) INDICATES TYPE OF DATA TRANSFER.
;; WHAT DOROUT DOES:
;; 1) INITS THE IMP, ON CHANNEL DOMP.
;; 2) ESTABLISHED DATA CONNECTION WITH FOREIGH TELNET.
;; 3) READS DATE FROM LOCAL FILE SYSTEM, TRANSMITTING IT
;; TO THE IMP.
;; 4) CLOSES DATA CONNECTION ON EOF FROM FILE SYSTEM
DOROUT: TLNE FLG,LISTFL ;IF THIS IS THE LIST COMMAND,
JRST STATDO ; GO BACK TO STAT ROUTINE FOR OUR PART
MOVEI B,0
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST OCONER ; CAN'T MAKE DATA CONNECTION
MOVEI A,DOMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
MOVE E,[440700,,[ASCIZ /250 Look out! Here comes /]]
PUSHJ P,ASCIIE
PUSHJ P,ERRFN
MOVE E,[440700,,[ASCIZ/
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
SETOM NOEDIR# ;FLAG TO HELP ASCII TYPE FLUSH E DIRECTORY
DOROU1: HRROI C,-40
DOROU2: PUSHJ P,GETFIL ;C(A) ← BYTE OF DATA FROM FILE
JRST DOERR
JRST DOEOF
SOSG DOBUF+2 ;ROOM FOR BYTE IN DOMP BUFFER?
PUSHJ P,DOROU3 ; NO, DO OUTPUT TO IMP
IDPB A,DOBUF+1 ; YES, PUT IT IN
AOJL C,DOROU2 ;LOOP FOR NEXT BYTE IF NOT TOO MANY
PUSHJ P,SXACTV ;TOO MANY ALL AT ONCE, PAUSE SO THE
PUSHJ P,DOWAIT ; CONTROL LINK CAN GET IT IF IT WANTS
JRST DOROU1 ;CONTINUE
DOROU3: ;IT MIGHT BE NICE TO PUT A TEST HERE TO
; INSURE THAT THE OUTPUT WILL NOT HANG
OUT DOMP,
POPJ P,
MES (OUT DOMP fails)
JRST ERRKIL
DOEOF: PUSHJ P,DOMPSTR
ASCIZ /252 The End
/
DOEOF1: PUSHJ P,DOROU3
DOEOF2: RELEASE FOMP,
RELEASE DOMP,
SETZM DOACTV
SKIPN QUITNG ;IF TRIED TO QUIT, TRY AGAIN
POPJ P, ; (QUITTERS NEVER QUIT QUITTING)
JRST BYE1
DOERR: PUSHJ P,DOMPSTR
ASCIZ /453 RETR incomplete, local file system error
/
JRST DOEOF1
OCONER: PUSHJ P,DOMPSTR
ASCIZ /454 RETR incomplete, can't connect to your data socket
/
JRST DOEOF2
>;repeat 0
;GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK
repeat 0,< ;whole page
;; GETFIL
;CALL: PUSHJ P,GETFIL
; ERROR RETURN
; EOF RETURN
; NORMAL RETURN
; Getfil -- Get data byte from local file system. GETDAT
GETFIL: MOVE A,DOTYPE ;GETTING FROM FILE IS HAIRY
CAIN A,1 ; IF IMAGE TYPE
JRST GETFI3 ; ELSE DROP THROUGH TO STANDARD ROUTINE
GETFI0: SOSG FOBUF+2 ;DATA BYTE IN BUFFER?
JRST GETFI2 ; NO, DO AN INPUT
GETFI1: ILDB A,FOBUF+1 ; YES, GET DATA BYTE
JRST GETFI6 ; AND RETURN UNLESS ASCII
GETFI2: IN FOMP, ;DO AN INPUT
JRST GETFI1 ; INPUT WAS SUCCESSFUL
GETSTS FOMP,B ; EOF OR ERROR, GET STATUS BITS IN B
TRNE B,IODEND ;EOF?
JRST CPOPJ1 ; YES
MES (Error detected on FOMP)
POPJ P,
GETFI3: SKIPE A,FOBTSL ;IMAGE MODE: MORE BITS IN THE CURRENT FILE WORD?
JRST GETFI4 ; YES, CARRY ON
MOVS A,DOBS ;ELSE CREATE A NEW BPT
LSH A,6 ;BYTE SIZE INTO S FIELD
IOR A,[POINT 0,FOWORD] ;POSITION TO BEGINNING OF WORD
MOVEM A,FOBPT
PUSHJ P,GETFI0 ;GET ANOTHER WORD
POPJ P, ;ERROR RETURNS
JRST CPOPJ1
MOVEM A,FOWORD ;SAVE FILE WORD FOR BYTE EXTRACTION
MOVEI A,=36 ;INIT BITS LEFT
GETFI4: SUB A,DOBS ;SUBTRACT BYTE SIZE FROM BITS LEFT IN WORD
MOVEM A,FOBTSL
JUMPL A,GETFI5 ;JUMP IF NOT ENOUGH
ILDB A,FOBPT ;THIS IS AN EASY ONE
JRST CPOPJ2
GETFI5: PUSHJ P,GETFI0 ;WRAPAROUND CASE, GET NEXT WORD
POPJ P,
JRST CPOPJ1
MOVEM A,FOTEMP ;SAVE NEXT WORD
MOVE B,A ;POSITION FOR LSHC
MOVE A,FOWORD
MOVN D,FOBTSL ;*** NOTE WE ARE USING AC D. C IS IN USE UPLEVEL.
LSHC A,(D) ;POSITION COMBINATION BYTE
AND A,FOMASK ;FLUSH CRUFT
MOVE B,FOTEMP
MOVEM B,FOWORD ;SET UP FOR NEW WORD
MOVEI B,=36
ADDB B,FOBTSL
LSH B,6 ;MAKE NEW BPT
ADD B,DOBS
LSH B,=24
HRRI B,FOWORD
MOVEM B,FOBPT
JRST CPOPJ2
GETFI6: SKIPE DOTYPE ;DONE EXCEPT FOR ASCII MODE
JRST CPOPJ2
JUMPE A,GETFIL ;FOR ASCII, WE FLUSH NULLS
MOVE B,@FOBUF+1 ; CHECK FOR SOS LINE NUMBERS
TRNN B,1
JRST GETFI7
MOVNI B,5
ADDM B,FOBUF+2
AOS FOBUF+1
JRST GETFIL
GETFI7: AOSE NOEDIR ; CHECK FOR E DIRECTORY
JRST GETFI8
MOVE D,FOBUF+1
MOVE B,(D)
CAME B,[ASCII /COMME/]
JRST GETFI8
MOVE B,1(D)
CAME B,[ASCII /NT ⊗ /]
JRST GETFI8
MOVE B,2(D)
CAME B,[ASCII / VAL/]
JRST GETFI8
GETF71: PUSHJ P,GETFIL
POPJ P,
JRST CPOPJ1
CAIE A,14
JRST GETF71
JRST GETFIL
GETFI8: CAIN A,175 ; AND TRANSLATE THE FUNNY ONES
MOVEI A,33 ;ALTMODE
CAIN A,176
MOVEI A,175 ;RIGHT BRACE
CAIN A,32
MOVEI A,176 ;TILDE
JRST CPOPJ2
FOBTSL: 0
FOWORD: 0
FOBPT: 0
FOTEMP: 0
FOMASK: 0
>;repeat 0
;NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
; OUTPUT IS TO DISK FILE
DEFINE STROUT(X) <
MOVEI B,X
PUSHJ P,WRTSTR
>
DEFINE OUT1 (X) <MOVE A,X ↔ XCT OUTINSTR>
DEFINE PRNUM(X,N) <
IFN X-T2,<MOVE T2,X ;arranged to be ok for this routine,
; to clobber T2 whenever prnum called>
PUSHJ P,NUMPR ;ok to generate multiple words
N ; in PRNUM -- this is min width
>;PRNUM
NUMPR:PUSH P,T1
MOVE T1,@-1(P)
PUSHJ P,NUMPR1
POP P,T1
AOS (P)
POPJ P,
NUMPR1:IDIVI T2,=10
IORI T3,"0"
HRLM T3,(P)
SUBI T1,1
JUMPE T2,.+2
PUSHJ P,NUMPR1
JUMPLE T1,DON0
OUT1 (["0"])
SOJG T1,.-1
DON0:HLRZ T2,(P)
OUT1 T2
POPJ P,
; THE DATGEN ROUTINE
DATGEN: DATE T1,
IDIVI T1,=31
ADDI T2,1
PUSH P,T2
NODA1: IDIVI T1,=12
MOVEI T3,261 ;DAYLIT
PEEK T3,
PEEK T3,
SKIPE T3
SKIPA T3,[PDDATE]
MOVEI T3,PSDATE
MOVEM T3,DTKIND
MOVEI B,@MONTAB(T2)
PUSHJ P,WRTSTR
POP P,A
IDIVI A,=10
JUMPE A,ONEDDD
ADDI A,"0"
XCT OUTINSTR
ONEDDD: MOVEI A,"0"(B)
XCT OUTINSTR
MOVEI B,[ASCIZ/, /]
PUSHJ P,WRTSTR
MOVEI T2,=1964(T1)
PRNUM (T2,2)
STROUT ([ASCIZ/ /])
NODATE: MSTIME T2,
IDIVI T2,=1000*=60
IDIVI T2,=60
MOVE T1,T3
PRNUM (T2,2)
MOVE T2,T1
PRNUM (T2,2)
NOTIME: STROUT (@DTKIND)
NOZON: POPJ P,
MONTAB: [ASCIZ/January /]
[ASCIZ/February /]
[ASCIZ/March /]
[ASCIZ/April /]
[ASCIZ/May /]
[ASCIZ/June /]
[ASCIZ/July /]
[ASCIZ/August /]
[ASCIZ/September /]
[ASCIZ/October /]
[ASCIZ/November /]
[ASCIZ/December /]
PDDATE: ASCIZ/ PDT/
PSDATE: ASCIZ/ PST/
DTKIND: 0
;ILEVEL DNTSAY timout SXACTV LOOK
; INTERRUPT LEVEL ROUTINE
ILEVEL: MOVE A,JOBCNI
ifn iverbose, <
PTOCNT LOOK
MOVE b,LOOK+1
CAILE b,120 ;make sure plenty of room in output buffer
JRST DNTSAY ;not enough room, avoid I-level schedule attempt
outchr ["↔"]
tlne a,intinp
outchr ["p"]
tlne a,intims
outchr ["s"]
TLNE A,INTINS
OUTCHR ["A"]
>;ifn iverbose
DNTSAY: tlne a,intclk
jrst timout
;; TLNE A,INTINS
;; SOS SYNCH ;IF THIS GOES NEGATIVE WE STOP TILL IT CATCHES UP
TLNE A,INTINS
SETZM CIHUNG ;PREPARES US FOR A COMMAND AT ONCE (BETTER BE ABOR)
TLNE A,INTIMS
SETOM SCHEKF ;Status CHEcK Flag
MOVE A,[-3]
MOVEM A,XACTV
DISMIS
timout: debreak
jrst errkil
SXACTV: PUSH P,[-3] ;HANDY ROUTINE TO SET XACTV
POP P,XACTV ; WITHOUT CLOBBERING ANY
POPJ P, ; ACCUMULATORS
ifn iverbose, <
LOOK: 0↔0
>
;⊗ GETHNM COPYUS GOTUS CPYHST CPYDUN HSTTAB HSTSIX WHYWHY
SUBTTL HOST NAME MAGIC USING NETWRK
GETHNM:
BEGIN NETHAK
PUSH P,A
SKIPN HSTADR ;maybe already mapped
PUSHJ P,MAPHST ;get host table mapped in
repeat 1,<
SKIPE OURSTR ;know our name yet?
JRST GOTUS ;yup, must have been here before
PUSHJ P,OURNAM ;get our host name
JRST [ MOVE 0,OURH3 ;use first host number
MOVEI 1,OURSTR ;put our number into OURSTR
PUSHJ P,HNUMST
JRST GOTUS]
HRLI 1,440700 ;copy our name to safe place
MOVE 2,[440700,,OURSTR]
COPYUS: ILDB 0,1
IDPB 0,2
JUMPN 0,COPYUS
GOTUS:
>;repeat 1
MOVE 0,HOSTNO ;get number of host we're connected to
PUSHJ P,HSTNUM ;convert to name
JRST [ MOVEI 1,HSTSTR ;Failed, make NETWRK put number in HSTSTR for us
PUSHJ P,HNUMST
JRST CPYDUN]
PUSH P,1 ;save ptr to name
HRLI 1,440700
MOVE 2,[440700,,HSTSTR]
CPYHST: ILDB 0,1
IDPB 0,2
JUMPN 0,CPYHST
POP P,1 ;ptr to name, for SETANM
CPYDUN: PUSHJ P,SETANM ;change our Alias to indicate foreign host
;;; PUSHJ P,UNMHST ;don't unmap, so that MLNMFF can use host table
POP P,A
POPJ P,
;Now preparation for inserting NETWRK.
HSTTAB←←1 ;indicate to NETWRK we want host table
HSTSIX←←1 ;also want code to generate alias from host name
IFN FTIP,<ERRTNS←←1> ;Also get error routine
WHYWHY: 0 ;unused, but ref'd by NETWRK's HSTDED (not called)
.INSERT NETWRK.FAI[S,NET]
INTERN HSTNAM,HSTNXA,HSTADR
BEND NETHAK
;⊗ BYE BYE1 BYE2 ERRKIL QUIT QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
; MISCELLANEOUS ERROR MESSAGES ERRKIL, BYE, QUIT, FLUSH, ABOR, GREET
BYE: PUSHJ P,FLUSCS ;THE COMMAND
BYE1: SKIPN DIACTV ;IF I/O ACTIVE, CAN'T QUIT YET
SKIPE DOACTV
JRST [SKIPE QUITNG ;GIVE INTERIM MESSAGE BUT ONCE
POPJ P,
SETOM QUITNG# ;THIS IS HOW
PUSHJ P,IMPSTR
ASCIZ /500 I'll split just as soon as the current transfer is done.
/
POPJ P,]
BYE2: PUSHJ P,IMPSTR
ASCIZ /221 CUL
/
ERRKIL: MTAPE IMP,NEWTMO ;Order of RELEASing changed to insure
RELEASE IMP, ;at least the control link gets closed.
PUSHJ P,FLUSH ;FLUSH ALL DATA I/O
MOVE A,['KILL-2']
MOVEM A,KFLAG
QUIT: RELEASE FIMP,3 ;IN CASE OF MAIL ABORT
SETZM PRIVS ;PARANOID? ME, PARANOID?
SKIPL RECOPN ;skip if no relay-log file open
RELEAS RLY, ;close it
SETOM RECOPN ;not open any more
RESET ;IF ATTACHED TO A TERMINAL,
SETZM HSTADR ;no host table mapped in now, since JOBFF reset
; MOVNI B,1 ; START OVER (TEST AGAIN
; GETLIN B ; IN CASE IT'S CHANGED).
; AOJN B,QUIT1
EXIT
QUIT1: OUTSTR [ASCIZ /Starting over
/]
JRST START
ABOR: SETZM DIACTV ;FLUSH ALL ACTIVITY
SETZM DOACTV
; SETZM DIHUNG ;AND RESET COROUTINES
; SETZM DOHUNG
PUSHJ P,IMPSTR ;BARF SO WHAT IF SCARCE RESOURCE
ASCIZ /250 El grande de grosse RSET
/
PUSHJ P,FLUSH
SETZM GOTFRM ;forget any From: line seen
JRST REGO ;RESET ALL ACTV, HUNG, AND PDLS
FLUSH: RELEASE FIMP,3 ;(The other mtapes get unassigned I/O
RELEASE FOMP,3 ;sometimes)
;; CHNSTS DIMP,A ;FIXING ABOVE LOSS
;; TRNE A,400000
;; MTAPE DIMP,NEWTMO
;; RELEASE DIMP,
;; CHNSTS DOMP,A ;FIXING ABOVE LOSS
;; TRNE A,400000
;; MTAPE DOMP,NEWTMO
;; RELEASE DOMP,
POPJ P,
NEWTMO: 17
BYTE (6) 2,24,24,7,7
NOIMP: MES(CANNOT INIT IMP)
JRST ERRKIL
UFLUSH: PUSHJ P,PUTBUF ; EXCRETE MESSAGE
MOVEI B,5
SLEEP B,
JRST QUIT
GREET: MOVE E,[-LOURH3,,OURH3] ;aobjn ptr to list of our host nbrs
MOVE B,HOSTNO ;get nbr of foreign host
GREETL: CAMN B,(E) ;is this one of our host nbrs?
JRST GREET0 ;host nbr is ours, let us in even if system down
AOBJN E,GREETL ;no, check other numbers
MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET0
PUSHJ P,IMPSTR
ASCIZ/421- /
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS SMTP Server at /
MOVE B,[PUSHJ P,PUTCH1] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
PUSHJ P,IMPSTR
ASCIZ\
421 Sorry, the system is being debugged. Try again later.
\
IFN FTIP,<
OUTSTR [ASCIZ/MaintMode: Refusing /]
PUSHJ P,SAYWHO
>;IFN FTIP
JRST UFLUSH
GREET0: PUSHJ P,IMPSTR
ASCIZ/220-/
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS SMTP Server at /
MOVE B,[PUSHJ P,PUTCH1] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
MOVEI B,256 ; LASTDISASTERTIME
PEEK B,
PEEK B,
JUMPE B,NOFLAK
ACCTIM A,
SUB A,B
TLZE A,1 ;FORGIVE ONE DAY
ADDI A,=24*=60*=60
CAILE A,=15*=60
JRST NOFLAK
PUSHJ P,IMPSTR
ASCIZ/
220-The system is misbehaving. Proceed with caution!/
NOFLAK: MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET1
PUSHJ P,IMPSTR
ASCIZ/
220-The system is being debugged./
GREET1: PUSHJ P,IMPSTR
ASCIZ\
220 Bugs/gripes to Bug-SMTP @ \
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPCR ;output crlf
POPJ P,
IFN FTIP,<
SAYWHO: OUTSTR [ASCIZ /Connection from host /]
PUSHJ P,GETHNM
OUTSTR HSTSTR
OUTSTR [ASCIZ/
/]
POPJ P,
>;IFN FTIP
END START